Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Config.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Config.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Config.pm	(revision 5095)
@@ -0,0 +1,353 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package FCM::Admin::Config;
+use base qw{FCM::Class::HASH};
+
+use FCM::Context::Locator;
+use FCM::Util;
+use File::Basename qw{dirname};
+use File::Spec::Functions qw{catfile};
+use FindBin;
+
+our $UTIL = FCM::Util->new();
+
+my $TRAC_LIVE_URL_TMPL = 'https://{host}/trac/{project}';
+my $USER_ID = (getpwuid($<))[0];
+
+__PACKAGE__->class({
+    # Emails
+    admin_email         => {isa => '$', default => $USER_ID},
+    notification_from   => {isa => '$'},
+
+    # Location for log files
+    log_dir             => {isa => '$', default => '/var/log/fcm'},
+
+    # FCM installation locations
+    fcm_home            => {isa => '$', default => dirname($FindBin::Bin)},
+    fcm_site_home       => {isa => '$', default => q{}},
+
+    # FCM installation mirror locations
+    mirror_dests        => {isa => '$', default => q{}},
+    mirror_keys         => {isa => '$', default => q{}},
+
+    # Subversion repositories settings
+    svn_backup_dir      => {isa => '$', default => '/var/svn/backups'},
+    svn_dump_dir        => {isa => '$', default => '/var/svn/dumps'},
+    svn_group           => {isa => '$', default => q{}},
+    svn_hook_path_env   => {isa => '$', default => q{}},
+    svn_live_dir        => {isa => '$', default => '/srv/svn'},
+    svn_passwd_file     => {isa => '$', default => q{}},
+    svn_project_suffix  => {isa => '$', default => q{}},
+
+    # Trac environments settings
+    trac_admin_users    => {isa => '$', default => q{}},
+    trac_backup_dir     => {isa => '$', default => '/var/trac/backups'},
+    trac_group          => {isa => '$', default => q{}},
+    trac_host_name      => {isa => '$', default => 'localhost'},
+    trac_ini_file       => {isa => '$', default => 'trac.ini'},
+    trac_live_dir       => {isa => '$', default => '/srv/trac'},
+    trac_live_url_tmpl  => {isa => '$', default => $TRAC_LIVE_URL_TMPL},
+    trac_passwd_file    => {isa => '$', default => q{}},
+
+    # User information tool settings
+    user_info_tool      => {isa => '$', default => 'passwd'},
+
+    # User information tool, LDAP settings
+    ldappw              => {isa => '$', default => '~/.ldappw'},
+    ldap_uri            => {isa => '$', default => q{}},
+    ldap_binddn         => {isa => '$', default => q{}},
+    ldap_basedn         => {isa => '$', default => q{}},
+    ldap_attrs          => {isa => '$', default => q{uid cn mail}},
+    ldap_filter_more    => {isa => '$', default => q{}},
+
+    # User information tool, passwd settings
+    passwd_email_domain => {isa => '$', default => q{}},
+    passwd_gid_max      => {isa => '$'},
+    passwd_uid_max      => {isa => '$'},
+    passwd_gid_min      => {isa => '$', default => 1000},
+    passwd_uid_min      => {isa => '$', default => 1000},
+});
+
+
+# Returns a unique instance of this class.
+my $INSTANCE;
+sub instance {
+    my ($class) = @_;
+    if (!defined($INSTANCE)) {
+        $INSTANCE = $class->new();
+        # Load $FCM_HOME/etc/fcm/admin.cfg and $HOME/.metomi/fcm/admin.cfg
+        $UTIL->cfg_init(
+            'admin.cfg',
+            sub {
+                my $config_reader = shift();
+                while (defined(my $entry = $config_reader->())) {
+                    my $label = $entry->get_label();
+                    if (exists($INSTANCE->{$label})) {
+                        $INSTANCE->{$label} = $entry->get_value();
+                    }
+                }
+            },
+        );
+    }
+    return $INSTANCE;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::Admin::Config
+
+=head1 SYNOPSIS
+
+    $config = FCM::Admin::Config->instance();
+    $dir = $config->get_svn_backup_dir();
+    # ...
+
+=head1 DESCRIPTION
+
+This class is used to retrieve/store configurations required by FCM
+admininstration scripts.
+
+It is a sub-class of L<FCM::Class::HASH|FCM::Class::HASH>.
+
+=head1 METHODS
+
+=over 4
+
+=item FCM::Admin::Config->instance()
+
+Returns a unique instance of this class. On first call, creates the instance
+with the configurations set to their default values; and loads from the
+site/user configuration at $FCM_HOME/etc/fcm/admin.cfg and
+$HOME/.metomi/fcm/admin.cfg.
+
+=back
+
+=head1 ATTRIBUTES
+
+Email addresses.
+
+=over 4
+
+=item admin_email
+
+The e-mail address of the FCM administrator.
+
+=item notification_from
+
+Notification email address (for the "From:" field in notification emails).
+
+=back
+
+Location for log files.
+
+=over 4
+
+=item log_dir
+
+The location for log files.
+
+=back
+
+Locations of FCM installation.
+
+=over 4
+
+=item fcm_home
+
+The source path of the default FCM distribution.
+
+=item fcm_site_home
+
+The source path of the default FCM site distribution.
+
+=back
+
+Settings on how to mirror FCM installation.
+
+=over 4
+
+=item mirror_dests
+
+A space-delimited list of destinations to mirror FCM installation.
+
+=item mirror_keys
+
+A string containing a list of source keys. Each source key should point
+to a source location in this $config. The source locations will be distributed
+to the list of destinations in C<mirror_dests>.
+
+=back
+
+Subversion repositories settings.
+
+=over 4
+
+=item svn_backup_dir
+
+The path to a directory containing the backups of SVN repositories.
+
+=item svn_dump_dir
+
+The path to a directory containing the revision dumps of SVN
+repositories.
+
+=item svn_group
+
+The group name in which Subversion repositories should be created in.
+
+=item svn_hook_dir
+
+The path to a directory containing source files of SVN hook scripts.
+
+=item svn_hook_path_env
+
+The value of the PATH environment variable, in which SVN hook scripts
+should run with.
+
+=item svn_live_dir
+
+The path to a directory containing the live SVN repositories.
+
+=item svn_passwd_file
+
+The base name of the SVN password file.
+
+=item svn_project_suffix
+
+The suffix added to the name of each SVN repository.
+
+=back
+
+Trac environment settings.
+
+=over 4
+
+=item trac_admin_users
+
+A space-delimited list of admin users for all Trac environments.
+
+=item trac_backup_dir
+
+The path to a directory containing the backups of Trac environments.
+
+=item trac_group
+
+The group name in which Trac environment files should be created in.
+
+=item trac_host_name
+
+The host name of the Trac server, from the user's perspective.
+
+=item trac_ini_file
+
+The base name of the Trac INI file.
+
+=item trac_live_dir
+
+The path to a directory containing the live Trac environments.
+
+=item trac_live_url_tmpl
+
+The template string for determining the URL of the Trac environment of a
+project.
+
+=item trac_passwd_file
+
+The base name of the Trac password file.
+
+=back
+
+=over 4
+
+User information tool settings.
+
+=item user_info_tool
+
+The name of the tool for obtaining user information.
+
+=back
+
+LDAP settings, only relevant if C<user_info_tool = ldap>
+
+=over 4
+
+=item ldappw
+
+File containing the password to the LDAP server, if required.
+
+=item ldap_uri
+
+The URI of the LDAP server.
+
+=item ldap_binddn
+
+The DN in the LDAP server to bind with to search the directory.
+
+=item ldap_basedn
+
+The DN in the LDAP server that is the base for a search.
+
+=item ldap_attrs
+
+The attributes for UID, common name and email in the LDAP directory.
+
+=item ldap_filter_more
+
+If specified, use the value as extra (AND) filters to an LDAP search.
+
+=back
+
+PASSWD settings, only relevant if user_info_tool = passwd
+
+=over 4
+
+=item passwd_email_domain
+
+Domain name to suffix user IDs to create an email address.
+
+=item passwd_gid_max
+
+Maximum GID considered to be a normal user group.
+
+=item passwd_uid_max
+
+Maximum UID considered to be a normal user.
+
+=item passwd_gid_min
+
+Minimum GID considered to be a normal user group. (default=1000)
+
+=item passwd_uid_min
+
+Minimum UID considered to be a normal user. (default=1000)
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Project.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Project.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Project.pm	(revision 5095)
@@ -0,0 +1,260 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package FCM::Admin::Project;
+
+use overload q{""} => \&get_name;
+use FCM::Admin::Config;
+use File::Spec;
+
+my $ARCHIVE_EXTENSION = q{.tgz};
+
+# ------------------------------------------------------------------------------
+# Creates a new instance of this class.
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+# ------------------------------------------------------------------------------
+# Returns the name of the project.
+sub get_name {
+    my ($self) = @_;
+    return $self->{name};
+}
+
+# ------------------------------------------------------------------------------
+# Returns the base name of the backup archive of the project's SVN repository.
+sub get_svn_archive_base_name {
+    my ($self) = @_;
+    return $self->get_svn_base_name() . $ARCHIVE_EXTENSION;
+}
+
+# ------------------------------------------------------------------------------
+# Returns the path of the backup archive of the project's SVN repository.
+sub get_svn_backup_path {
+    my ($self) = @_;
+    return File::Spec->catfile(
+        FCM::Admin::Config->instance()->get_svn_backup_dir(),
+        $self->get_svn_archive_base_name(),
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Returns the base name of the project's Subversion repository.
+sub get_svn_base_name {
+    my ($self) = @_;
+    return
+        $self->get_name()
+        . FCM::Admin::Config->instance()->get_svn_project_suffix();
+}
+
+# ------------------------------------------------------------------------------
+# Returns the path to the revision dumps of the project's SVN repository.
+sub get_svn_dump_path {
+    my ($self) = @_;
+    return File::Spec->catfile(
+        FCM::Admin::Config->instance()->get_svn_dump_dir(),
+        $self->get_svn_base_name(),
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Returns the path to the project's SVN live repository's hooks directory.
+sub get_svn_live_hook_path {
+    my ($self) = @_;
+    return File::Spec->catfile($self->get_svn_live_path(), q{hooks});
+}
+
+# ------------------------------------------------------------------------------
+# Returns the path to the project's SVN live repository.
+sub get_svn_live_path {
+    my ($self) = @_;
+    return File::Spec->catfile(
+        FCM::Admin::Config->instance()->get_svn_live_dir(),
+        $self->get_svn_base_name(),
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Returns the file:// URI to the project's SVN live repository.
+sub get_svn_file_uri {
+    my ($self) = @_;
+    return q{file://} . $self->get_svn_live_path();
+    # Note: can use URI::file in theory, but it returns file:/path (instead of
+    #       file:///path) which Subversion does not like.
+}
+
+# ------------------------------------------------------------------------------
+# Returns the base name of the project's Trac environment backup archive.
+sub get_trac_archive_base_name {
+    my ($self) = @_;
+    return $self->get_name() . $ARCHIVE_EXTENSION;
+}
+
+# ------------------------------------------------------------------------------
+# Returns the path to the project's Trac backup archive.
+sub get_trac_backup_path {
+    my ($self) = @_;
+    return File::Spec->catfile(
+        FCM::Admin::Config->instance()->get_trac_backup_dir(),
+        $self->get_trac_archive_base_name(),
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Returns the path to the project's Trac live environment's database.
+sub get_trac_live_db_path {
+    my ($self) = @_;
+    return File::Spec->catfile($self->get_trac_live_path(), qw{db trac.db});
+}
+
+# ------------------------------------------------------------------------------
+# Returns the path to the project's Trac live environment's INI file.
+sub get_trac_live_ini_path {
+    my ($self) = @_;
+    return File::Spec->catfile($self->get_trac_live_path(), qw{conf trac.ini});
+}
+
+# ------------------------------------------------------------------------------
+# Returns the path to the project's Trac live environment.
+sub get_trac_live_path {
+    my ($self) = @_;
+    return File::Spec->catfile(
+        FCM::Admin::Config->instance()->get_trac_live_dir(),
+        $self->get_name(),
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Returns the URL to the project's Trac live environment.
+sub get_trac_live_url {
+    my ($self) = @_;
+    my $return = FCM::Admin::Config->instance()->get_trac_live_url_tmpl();
+    for (
+        ['{host}', FCM::Admin::Config->instance()->get_trac_host_name()],
+        ['{project}', $self->get_name()],
+    ) {
+        my ($key, $value) = @{$_};
+        my $index = index($return, $key);
+        if ($index > -1) {
+            substr($return, $index, length($key), $value);
+        }
+    }
+    $return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::Admin::Project
+
+=head1 SYNOPSIS
+
+    use FCM::Admin::Project;
+    $project = FCM::Admin::Project->new({name => 'foo'});
+    $path = $project->get_svn_live_path();
+
+=head1 DESCRIPTION
+
+An object of this class represents a project hosted/managed by FCM. The methods
+of this class relies on L<FCM::Admin::Config|FCM::Admin::Config> for many of the
+configurations.
+
+=head1 METHODS
+
+=over 4
+
+=item FCM::Admin::Project->new({name => $name})
+
+Returns a new instance. A name of the project must be specified.
+
+=item $project->get_name()
+
+Returns the name of the project.
+
+=item $project->get_svn_archive_base_name()
+
+Returns the base name of the backup archive of the project's Subversion
+repository.
+
+=item $project->get_svn_backup_path()
+
+Returns the path to the backup archive of the project's Subversion repository.
+
+=item $project->get_svn_base_name()
+
+Returns the base name of the project's Subversion repository.
+
+=item $project->get_svn_dump_path()
+
+Returns the path to the revision dumps of the project's Subversion repository.
+
+=item $project->get_svn_live_hook_path()
+
+Returns the path to the project's SVN live repository's hooks directory.
+
+=item $project->get_svn_live_path()
+
+Returns the path to the project's SVN live repository.
+
+=item $project->get_svn_file_uri()
+
+Returns the file:// URI to the project's SVN live repository.
+
+=item $project->get_trac_archive_base_name()
+
+Returns the base name of the project's Trac environment backup archive.
+
+=item $project->get_trac_backup_path()
+
+Returns the path to the project's Trac backup archive.
+
+=item $project->get_trac_live_db_path()
+
+Returns the path to the project's Trac live environment's database.
+
+=item $project->get_trac_live_ini_path()
+
+Returns the path to the project's Trac live environment's INI file.
+
+=item $project->get_trac_live_path()
+
+Returns the path to the project's Trac live environment.
+
+=item $project->get_trac_live_url()
+
+Returns the URL to the project's Trac live environment.
+
+=back
+
+=head1 SEE ALSO
+
+L<FCM::Admin::Config|FCM::Admin::Config>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Runner.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Runner.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Runner.pm	(revision 5095)
@@ -0,0 +1,299 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package FCM::Admin::Runner;
+
+use IO::Handle;
+use POSIX qw{strftime};
+
+# The default values of the attributes
+my %DEFAULT = (
+    exceptions     => [],
+    max_attempts   => 3,
+    retry_interval => 5,
+    stderr_handle  => \*STDERR,
+    stdout_handle  => \*STDOUT,
+);
+
+my $INSTANCE;
+
+# ------------------------------------------------------------------------------
+# Returns a unique instance of this class. Creates the instance on first call.
+sub instance {
+    my ($class) = @_;
+    if (!defined($INSTANCE)) {
+        $INSTANCE = bless({%DEFAULT}, $class);
+    }
+    return $INSTANCE;
+}
+
+# ------------------------------------------------------------------------------
+# Adds a new exception to the list of exceptions.
+sub _add_exception {
+    my ($self, $exception) = @_;
+    push(@{$self->get_exceptions()}, $exception);
+}
+
+# ------------------------------------------------------------------------------
+# Returns the list of exceptions (or a reference to the list in scalar context).
+sub get_exceptions {
+    my ($self) = @_;
+    return (wantarray() ? @{$self->{exceptions}} : $self->{exceptions});
+}
+
+# ------------------------------------------------------------------------------
+# Returns the latest exception in the exception list.
+sub get_latest_exception {
+    my ($self) = @_;
+    if (exists($self->get_exceptions()->[-1])) {
+        return $self->get_exceptions()->[-1];
+    }
+    else {
+        return;
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Returns the maximum number of attempts for the "run_with_retries" method.
+sub get_max_attempts {
+    my ($self) = @_;
+    return $self->{max_attempts};
+}
+
+# ------------------------------------------------------------------------------
+# Returns the retry interval for the "run_with_retries" method.
+sub get_retry_interval {
+    my ($self) = @_;
+    return $self->{retry_interval};
+}
+
+# ------------------------------------------------------------------------------
+# Returns the file handle for STDERR.
+sub get_stderr_handle {
+    my ($self) = @_;
+    if (!IO::Handle::opened($self->{stderr_handle})) {
+        $self->{stderr_handle} = $DEFAULT{stderr_handle};
+    }
+    return $self->{stderr_handle};
+}
+
+# ------------------------------------------------------------------------------
+# Returns the file handle for STDOUT.
+sub get_stdout_handle {
+    my ($self) = @_;
+    if (!IO::Handle::opened($self->{stdout_handle})) {
+        $self->{stdout_handle} = $DEFAULT{stdout_handle};
+    }
+    return $self->{stdout_handle};
+}
+
+# ------------------------------------------------------------------------------
+# Runs $sub_ref->(@arguments) with a diagnostic $message. Dies on error.
+sub run {
+    my ($self, $message, $sub_ref, @arguments) = @_;
+    printf(
+        {$self->get_stdout_handle()}
+        qq{%s: %s\n}, strftime("%Y-%m-%dT%H:%M:%SZ", gmtime()), $message,
+    );
+    eval {
+        if (!$sub_ref->(@arguments)) {
+            die(qq{\n});
+        }
+    };
+    if ($@) {
+        my $e = $@;
+        chomp($e);
+        my $exception
+            = sprintf(qq{ERROR %s%s\n}, $message, ($e ? qq{ - $e} : qq{}));
+        $self->_add_exception($exception);
+        die($exception);
+    }
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Runs $sub_ref->(@arguments) with a diagnostic $message. Warns on error.
+sub run_continue {
+    my ($self, $message, $sub_ref, @arguments) = @_;
+    my $rc;
+    eval {
+        $rc = $self->run($message, $sub_ref, @arguments);
+    };
+    if ($@) {
+        print({$self->get_stderr_handle()} $@);
+        return;
+    }
+    return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# Runs $sub_ref->(@arguments) with a diagnostic $message. Retries on error.
+sub run_with_retries {
+    my ($self, $message, $sub_ref, @arguments) = @_;
+    for my $i_attempt (1 .. $self->get_max_attempts()) {
+        my $attempt_message = sprintf(
+            qq{%s, attempt %d of %d},
+            $message, $i_attempt, $self->get_max_attempts(),
+        );
+        if ($i_attempt == $self->get_max_attempts()) {
+            return $self->run($attempt_message, $sub_ref, @arguments);
+        }
+        else {
+            if ($self->run_continue($attempt_message, $sub_ref, @arguments)) {
+                return 1;
+            }
+            sleep($self->get_retry_interval());
+        }
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Sets the maximum number of attempts for the "run_with_retries" method.
+sub set_max_attempts {
+    my ($self, $value) = @_;
+    $self->{max_attempts} = $value;
+}
+
+# ------------------------------------------------------------------------------
+# Sets the retry interval for the "run_with_retries" method.
+sub set_retry_interval {
+    my ($self, $value) = @_;
+    $self->{retry_interval} = $value;
+}
+
+# ------------------------------------------------------------------------------
+# Sets the file handle for STDERR.
+sub set_stderr_handle {
+    my ($self, $value) = @_;
+    if (defined($value) && IO::Handle::opened($value)) {
+        $self->{stderr_handle} = $value;
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Sets the file handle for STDOUT.
+sub set_stdout_handle {
+    my ($self, $value) = @_;
+    if (defined($value) && IO::Handle::opened($value)) {
+        $self->{stdout_handle} = $value;
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::Admin::Runner
+
+=head1 SYNOPSIS
+
+    $runner = FCM::Admin::Runner->instance();
+    $runner->run($message, sub { ... });
+
+=head1 DESCRIPTION
+
+Provides a simple way to run a piece of code with a time-stamped diagnostic
+message.
+
+=head1 METHODS
+
+=over 4
+
+=item FCM::Admin::Runner->instance()
+
+Returns a unique instance of FCM::Admin::Runner.
+
+=item $runner->get_exceptions()
+
+Returns a list containing all the exceptions captured by the previous
+invocations of the $runner->run() method. In SCALAR context, returns a reference
+to the list.
+
+=item $runner->get_latest_exception()
+
+Returns the latest exception captured by the $runner->run() method. Returns
+undef if there is no captured exception in the list.
+
+=item $runner->get_max_attempts()
+
+Returns the number of maximum retries for the
+$runner->run_with_retries($message,$sub_ref,@arguments) method. (Default: 3)
+
+=item $runner->get_retry_interval()
+
+Returns the interval (in seconds) between retries for the
+$runner->run_with_retries($message,$sub_ref,@arguments) method. (Default: 5)
+
+=item $runner->get_stderr_handle()
+
+Returns the file handle for standard error output. (Default: \*STDERR)
+
+=item $runner->get_stdout_handle()
+
+Returns the file handle for standard output. (Default: \*STDOUT)
+
+=item $runner->run($message,$sub_ref,@arguments)
+
+Prints the diagnostic $message and runs $sub_ref (with extra @arguments).
+Returns true if $sub_ref returns true. die() with a message that looks like
+"ERROR $message\n" if $sub_ref returns false or die().
+
+=item $runner->run_continue($message,$sub_ref,@arguments)
+
+Same as $runner->run($message,$sub_ref,@arguments), but only issue a warning
+(and returns false) if $sub_ref returns false or die().
+
+=item $runner->run_with_retries($message,$sub_ref,@arguments)
+
+Attempts $runner->run($message,$sub_ref,@arguments) for a number of times up to
+$runner->get_max_attempts(), with a delay of $runner->get_retry_interval()
+between each attempt. die() if $sub_ref still returns false in the final
+attempt. Returns true on success.
+
+=item $runner->set_max_attempts($value)
+
+Sets the maximum number of attempts in the
+$runner->run_with_retries($message,$sub_ref,@arguments) method.
+
+=item $runner->set_retry_interval($value)
+
+Sets the interval (in seconds) between retries for the
+$runner->run_with_retries($message,$sub_ref,@arguments) method.
+
+=item $runner->set_stderr_handle($value)
+
+Sets the file handle for standard error output to an alternate file handle. The
+$value must be a valid file descriptor.
+
+=item $runner->set_stdout_handle($value)
+
+Sets the file handle for standard output to an alternate file handle. The $value
+must be a valid file descriptor.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/System.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/System.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/System.pm	(revision 5095)
@@ -0,0 +1,1414 @@
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package FCM::Admin::System;
+
+use Config::IniFiles;
+use DBI; # See also: DBD::SQLite
+use Exporter qw{import};
+use FCM::Admin::Config;
+use FCM::Admin::Project;
+use FCM::Admin::Runner;
+use FCM::Admin::User;
+use FCM::Admin::Util qw{
+    read_file
+    run_copy
+    run_create_archive
+    run_extract_archive
+    run_mkpath
+    run_rename
+    run_rmtree
+    run_rsync
+    run_symlink
+    write_file
+};
+use Fcntl qw{:mode}; # for S_IRGRP, S_IWGRP, S_IROTH, etc
+use File::Basename qw{basename dirname};
+use File::Compare qw{compare};
+use File::Find qw{find};
+use File::Spec::Functions qw{catfile rel2abs};
+use File::Temp qw{tempdir tempfile};
+use IO::Compress::Gzip qw{gzip};
+use IO::Dir;
+use IO::Pipe;
+use IO::Zlib;
+use List::Util qw{first};
+use POSIX qw{strftime};
+use Text::ParseWords qw{shellwords};
+
+our @EXPORT_OK = qw{
+    add_svn_repository
+    add_trac_environment
+    backup_svn_repository
+    backup_trac_environment
+    backup_trac_files
+    distribute_wc
+    filter_projects
+    get_projects_from_svn_backup
+    get_projects_from_svn_live
+    get_projects_from_trac_backup
+    get_projects_from_trac_live
+    get_users
+    housekeep_svn_hook_logs
+    install_svn_hook
+    manage_users_in_svn_passwd
+    manage_users_in_trac_passwd
+    manage_users_in_trac_db_of
+    recover_svn_repository
+    recover_trac_environment
+    recover_trac_files
+    vacuum_trac_env_db
+    verify_users
+};
+
+our $NO_OVERWRITE = 1;
+our $BUFFER_SIZE = 4096;
+our @SVN_REPOS_ROOT_HOOK_ITEMS = qw{commit.conf svnperms.conf};
+our %USER_INFO_TOOL_OF = (
+    'ldap'   => 'FCM::Admin::Users::LDAP',
+    'passwd' => 'FCM::Admin::Users::Passwd',
+);
+our $USER_INFO_TOOL;
+
+our $UTIL = $FCM::Admin::Config::UTIL;
+my $CONFIG = FCM::Admin::Config->instance();
+my $RUNNER = FCM::Admin::Runner->instance();
+
+# ------------------------------------------------------------------------------
+# Adds a new Subversion repository.
+sub add_svn_repository {
+    my ($project_name) = @_;
+    my $project = FCM::Admin::Project->new({name => $project_name});
+    if (-e $project->get_svn_live_path()) {
+        die(sprintf(
+            "%s: Subversion repository already exists at %s.\n",
+            $project_name,
+            $project->get_svn_live_path(),
+        ));
+    }
+    my $repos_path = $project->get_svn_live_path();
+    $RUNNER->run(
+        "creating Subversion repository at $repos_path",
+        sub {!system(qw{svnadmin create}, $repos_path)},
+    );
+    my $group = $CONFIG->get_svn_group();
+    if ($group) {
+        _chgrp_and_chmod($project->get_svn_live_path(), $group);
+    }
+    install_svn_hook($project);
+    housekeep_svn_hook_logs($project);
+}
+
+# ------------------------------------------------------------------------------
+# Adds a new Trac environment.
+sub add_trac_environment {
+    my ($project_name) = @_;
+    my $project = FCM::Admin::Project->new({name => $project_name});
+    if (-e $project->get_trac_live_path()) {
+        die(sprintf(
+            "%s: Trac environment already exists at %s.\n",
+            $project_name,
+            $project->get_trac_live_path(),
+        ));
+    }
+    my $RUN = sub{$RUNNER->run(@_)};
+    my $TRAC_ADMIN = sub {
+        my ($log, @args) = @_;
+        my @command = (q{trac-admin}, $project->get_trac_live_path(), @args);
+        $RUN->($log, sub {!system(@command)});
+    };
+    $TRAC_ADMIN->(
+        "initialising Trac environment",
+        q{initenv},
+        $project_name,
+        q{sqlite:db/trac.db},
+        q{--inherit=../../trac.ini},
+    );
+    my $group = $CONFIG->get_trac_group();
+    if ($group) {
+        _chgrp_and_chmod($project->get_trac_live_path(), $group);
+    }
+    for my $item (qw{component1 component2}) {
+        $TRAC_ADMIN->(
+            "removing example component $item", qw{component remove}, $item,
+        );
+    }
+    for my $item (qw{1.0 2.0}) {
+        $TRAC_ADMIN->(
+            "removing example version $item", qw{version remove}, $item,
+        );
+    }
+    for my $item (qw{milestone1 milestone2 milestone3 milestone4}) {
+        $TRAC_ADMIN->(
+            "removing example milestone $item", qw{milestone remove}, $item,
+        );
+    }
+    for my $item (
+        ['major'    => 'normal'  ],
+        ['critical' => 'major'   ],
+        ['blocker'  => 'critical'],
+    ) {
+        my ($old, $new) = @{$item};
+        $TRAC_ADMIN->(
+            "changing priority $old to $new", qw{priority change}, $old, $new,
+        );
+    }
+    if (-d $project->get_svn_live_path()) {
+        $TRAC_ADMIN->(
+            "adding repository",
+            qw{repository add (default)},
+            $project->get_svn_live_path(),
+        );
+    }
+    $TRAC_ADMIN->(
+        "adding admin permission", qw{permission add admin TRAC_ADMIN},
+    );
+    $TRAC_ADMIN->(
+        "adding admin permission", qw{permission add owner TRAC_ADMIN},
+    );
+    my @admin_users = shellwords($CONFIG->get_trac_admin_users());
+    for my $item (@admin_users) {
+        $TRAC_ADMIN->(
+            "adding admin user $item", qw{permission add}, $item, q{admin},
+        );
+    }
+    $TRAC_ADMIN->(
+        "adding TICKET_EDIT_CC permission to authenticated",
+        qw{permission add}, 'authenticated', qw{TICKET_EDIT_CC},
+    );
+    $TRAC_ADMIN->(
+        "adding TICKET_EDIT_DESCRIPTION permission to authenticated",
+        qw{permission add}, 'authenticated', qw{TICKET_EDIT_DESCRIPTION},
+    );
+    $RUN->(
+        "adding names and emails of users",
+        sub {manage_users_in_trac_db_of($project, get_users())},
+    );
+    $RUN->(
+        "updating configuration file",
+        sub {
+            my $trac_ini_path = $project->get_trac_live_ini_path();
+            my $trac_ini = Config::IniFiles->new(q{-file} => $trac_ini_path);
+            if (!$trac_ini) {
+                die("$trac_ini_path: cannot open.\n");
+            }
+            for (
+                #section    #key        #value
+                ['inherit', 'file'    , '../../trac.ini,../../intertrac.ini'],
+                ['project', 'descr'   , $project->get_name()                ],
+                ['trac'   , 'base_url', $project->get_trac_live_url()       ],
+            ) {
+                my ($section, $key, $value) = @{$_};
+                if (!$trac_ini->SectionExists($section)) {
+                    $trac_ini->AddSection($section);
+                }
+                if (!$trac_ini->newval($section, $key, $value)) {
+                    die("$trac_ini_path: $section:$key: cannot set value.\n");
+                }
+            }
+            return $trac_ini->RewriteConfig();
+        },
+    );
+    $RUN->(
+        "updating InterTrac",
+        sub {
+            my $ini_path = catfile(
+                $CONFIG->get_trac_live_dir(),
+                'intertrac.ini',
+            );
+            if (!-e $ini_path) {
+                open(my $handle, '>', $ini_path) || die("$ini_path: $!\n");
+                close($handle) || die("$ini_path: $!\n");
+            }
+            my $trac_ini = Config::IniFiles->new(
+                q{-allowempty} => 1,
+                q{-file} => $ini_path,
+            );
+            if (!defined($trac_ini)) {
+                die("$ini_path: cannot open.\n");
+            }
+            if (!$trac_ini->SectionExists(q{intertrac})) {
+                $trac_ini->AddSection(q{intertrac});
+            }
+            my $name = $project->get_name();
+            for (
+                [q{title} , $name                        ],
+                [q{url}   , $project->get_trac_live_url()],
+                [q{compat}, 'false'                      ],
+            ) {
+                my ($key, $value) = @{$_};
+                my $option = lc($name) . q{.} . $key;
+                if (!$trac_ini->newval(q{intertrac}, $option, $value)) {
+                    die("$ini_path: intertrac:$option: cannot set value.\n");
+                }
+            }
+            return $trac_ini->RewriteConfig();
+        },
+    );
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Backup the SVN repository of a project.
+sub backup_svn_repository {
+    my ($option_hash_ref, $project) = @_;
+    my $RUN = sub {FCM::Admin::Runner->instance()->run(@_)};
+    if (!exists($option_hash_ref->{'no-pack'})) {
+        $RUN->(
+            sprintf("packing %s", $project->get_svn_live_path()),
+            sub {!system(qw{svnadmin pack}, $project->get_svn_live_path())},
+        );
+    }
+    my $base_name = $project->get_svn_base_name();
+    run_mkpath($CONFIG->get_svn_backup_dir());
+    my $work_dir = tempdir("$base_name.backup.XXXXXX", CLEANUP => 1, TMPDIR => 1);
+    my $work_path = catfile($work_dir, $base_name);
+    $RUN->(
+        sprintf(
+            "hotcopying %s to %s", $project->get_svn_live_path(), $work_path,
+        ),
+        sub {!system(
+            qw{svnadmin hotcopy}, $project->get_svn_live_path(), $work_path,
+        )},
+        # Note: "hotcopy" is not yet possible via SVN::Repos
+    );
+    if (!exists($option_hash_ref->{'no-verify-integrity'})) {
+        my $VERIFIED_REVISION_REGEX = qr{\A\*\s+Verified\s+revision\s+\d+\.}xms;
+        $RUN->(
+            "verifying integrity of SVN repository of $project",
+            sub {
+                my $pipe = IO::Pipe->new();
+                $pipe->reader(sprintf(
+                    qq{svnadmin verify %s 2>&1}, $work_path,
+                ));
+                while (my $line = $pipe->getline()) {
+                    if ($line !~ $VERIFIED_REVISION_REGEX) { # don't print
+                        print($line);
+                    }
+                }
+                $pipe->close();
+                return $? ? () : (1);
+                # Note: "verify" is not yet possible via SVN::Repos
+            },
+        );
+    }
+    _create_backup_archive(
+        $work_path,
+        $CONFIG->get_svn_backup_dir(),
+        $project->get_svn_archive_base_name(),
+    );
+    if (!exists($option_hash_ref->{'no-housekeep-dumps'})) {
+        my $base_name = $project->get_svn_base_name();
+        my $dump_path = $CONFIG->get_svn_dump_dir();
+        my $youngest = _svnlook_youngest($work_path);
+        # Note: could use SVN::Repos for "youngest"
+        $RUN->(
+            "housekeeping $dump_path/$base_name-*.gz",
+            sub {
+                my @rev_dump_paths;
+                _get_files_from(
+                    $dump_path,
+                    sub {
+                        my ($dump_base_name, $path) = @_;
+                        my ($name, $rev)
+                            = $dump_base_name =~ qr{\A(.*)-(\d+)\.gz\z}msx;
+                        if (    !$name
+                            ||  !$rev
+                            ||  $name ne $base_name
+                            ||  $rev > $youngest
+                        ) {
+                            return;
+                        }
+                        push(@rev_dump_paths, $path);
+                    },
+                );
+                for my $rev_dump_path (@rev_dump_paths) {
+                    run_rmtree($rev_dump_path);
+                }
+                return 1;
+            }
+        );
+    }
+    run_rmtree($work_dir);
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Backup the Trac environment of a project.
+sub backup_trac_environment {
+    my ($option_hash_ref, $project) = @_;
+    my $trac_live_path = $project->get_trac_live_path();
+    my $base_name = $project->get_name();
+    run_mkpath($CONFIG->get_trac_backup_dir());
+    my $work_dir = tempdir("$base_name.backup.XXXXXX", CLEANUP => 1, TMPDIR => 1);
+    my $work_path = catfile($work_dir, $base_name);
+    $RUNNER->run_with_retries(
+        sprintf(
+            qq{hotcopying %s to %s},
+            $project->get_trac_live_path(),
+            $work_path,
+        ),
+        sub {
+            return !system(
+                q{trac-admin},
+                $project->get_trac_live_path(),
+                q{hotcopy},
+                $work_path,
+            );
+        },
+    );
+    if (!exists($option_hash_ref->{'no-verify-integrity'})) {
+        my $db_path = catfile($work_path, qw{db trac.db});
+        my $db_name = catfile($project->get_name(), qw{db trac.db});
+        $RUNNER->run(
+            "checking $db_name for integrity",
+            sub {
+                my $db_handle
+                    = DBI->connect(qq{dbi:SQLite:dbname=$db_path}, q{}, q{});
+                if (!$db_handle) {
+                    return;
+                }
+                my $rc = defined($db_handle->do(q{pragma integrity_check;}));
+                $db_handle->disconnect();
+                return $rc;
+            },
+        );
+    }
+    _create_backup_archive(
+        $work_path,
+        $CONFIG->get_trac_backup_dir(),
+        $project->get_trac_archive_base_name(),
+    );
+    run_rmtree($work_dir);
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Backup misc files in the Trac live directory to the Trac backup directory.
+sub backup_trac_files {
+    # (no argument)
+    _copy_files($CONFIG->get_trac_live_dir(), $CONFIG->get_trac_backup_dir());
+}
+
+# ------------------------------------------------------------------------------
+# Distributes the central FCM working copy to standard locations.
+sub distribute_wc {
+    my $rc = 1;
+    my @RSYNC_OPTS = qw{--timeout=1800 --exclude=.*};
+    my @sources;
+    for my $source_key (shellwords($CONFIG->get_mirror_keys())) {
+        my $method = "get_$source_key";
+        if ($CONFIG->can($method)) {
+            push(@sources, $CONFIG->$method());
+        }
+    }
+    for my $dest (shellwords($CONFIG->get_mirror_dests())) {
+        $rc = $RUNNER->run_continue(
+            "distributing FCM to $dest",
+            sub {
+                run_rsync(
+                    \@sources, $dest,
+                    [@RSYNC_OPTS, qw{-a --delete-excluded}],
+                );
+            },
+        ) && $rc;
+    }
+    return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# Returns a filtered list of projects matching names in a list.
+sub filter_projects {
+    my ($project_list_ref, $filter_list_ref) = @_;
+    if (!@{$filter_list_ref}) {
+        return @{$project_list_ref};
+    }
+    my %project_of = map {($_->get_name(), $_)} @{$project_list_ref};
+    my @projects;
+    my @unmatched_names;
+    for my $name (@{$filter_list_ref}) {
+        if (exists($project_of{$name})) {
+            push(@projects, $project_of{$name});
+        }
+        else {
+            push(@unmatched_names, $name);
+        }
+    }
+    if (@unmatched_names) {
+        die("@unmatched_names: not found\n");
+    }
+    return @projects;
+}
+
+# ------------------------------------------------------------------------------
+# Returns a list of projects by searching the backup SVN directory.
+sub get_projects_from_svn_backup {
+    # (no dummy argument)
+    my $SVN_PROJECT_SUFFIX = $CONFIG->get_svn_project_suffix();
+    my @projects;
+    _get_files_from(
+        $CONFIG->get_svn_backup_dir(),
+        sub {
+            my ($base_name, $path) = @_;
+            my $name = $base_name;
+            if ($name !~ s{$SVN_PROJECT_SUFFIX\.tgz\z}{}xms) {
+                return;
+            }
+            if (!-f $path) {
+                return;
+            }
+            push(@projects, FCM::Admin::Project->new({name => $name}));
+        },
+    );
+    return @projects;
+}
+
+# ------------------------------------------------------------------------------
+# Returns a list of projects by searching the live SVN directory.
+sub get_projects_from_svn_live {
+    # (no dummy argument)
+    my $SVN_PROJECT_SUFFIX = $CONFIG->get_svn_project_suffix();
+    my @projects;
+    _get_files_from(
+        $CONFIG->get_svn_live_dir(),
+        sub {
+            my ($base_name, $path) = @_;
+            my $name = $base_name;
+            $name =~ s{$SVN_PROJECT_SUFFIX\z}{}xms;
+            if (!-d $path) {
+                return;
+            }
+            push(@projects, FCM::Admin::Project->new({name => $name}));
+        },
+    );
+    return @projects;
+}
+
+# ------------------------------------------------------------------------------
+# Returns a list of projects by searching the backup Trac directory.
+sub get_projects_from_trac_backup {
+    # (no dummy argument)
+    my @projects;
+    _get_files_from(
+        $CONFIG->get_trac_backup_dir(),
+        sub {
+            my ($base_name, $path) = @_;
+            my $name = $base_name;
+            if ($name !~ s{\.tgz\z}{}xms) {
+                return;
+            }
+            if (!-f $path) {
+                return;
+            }
+            push(@projects, FCM::Admin::Project->new({name => $name}));
+        },
+    );
+    return @projects;
+}
+
+# ------------------------------------------------------------------------------
+# Returns a list of projects by searching the live Trac directory.
+sub get_projects_from_trac_live {
+    # (no dummy argument)
+    my @projects;
+    _get_files_from(
+        $CONFIG->get_trac_live_dir(),
+        sub {
+            my ($name, $path) = @_;
+            if (!-d $path) {
+                return;
+            }
+            push(@projects, FCM::Admin::Project->new({name => $name}));
+        },
+    );
+    return @projects;
+}
+
+# ------------------------------------------------------------------------------
+# Return a HASH of valid users. If @only_users, then return only users matching
+# these IDs.
+sub get_users {
+    my @only_users = @_;
+    my $name = $CONFIG->get_user_info_tool();
+    if (!defined($USER_INFO_TOOL)) {
+        my $class = $UTIL->class_load($USER_INFO_TOOL_OF{$name});
+        $USER_INFO_TOOL = $class->new({util => $UTIL});
+    }
+    my $user_hash_ref = $USER_INFO_TOOL->get_users_info(@only_users);
+    if (!%{$user_hash_ref}) {
+        die("No user found via $name.\n");
+    }
+    return $user_hash_ref;
+}
+
+# ------------------------------------------------------------------------------
+# Housekeep logs generated by hook scripts of a SVN project.
+sub housekeep_svn_hook_logs {
+    my ($project) = @_;
+    my $project_path = $project->get_svn_live_path();
+    my $hook_source_dir = catfile($CONFIG->get_fcm_home(), 'etc', 'svn-hooks');
+    my $today = strftime("%Y%m%d", gmtime());
+    my $date_p1w = strftime("%Y%m%d", gmtime(time() - 604800)); # 1 week ago
+    my $date_p4w = strftime("%Y%m%d", gmtime(time() - 2419200)); # 4 weeks ago
+    my @hook_names = map {basename($_)} glob(catfile($hook_source_dir, q{*}));
+    for my $hook_name (sort @hook_names) {
+        my $log_path = catfile($project_path, 'log', $hook_name . '.log');
+        my $log_path_cur;
+        # Determine whether log file is more than a week old
+        if (    -l $log_path
+            &&  index(readlink($log_path), $hook_name . '.log.') == 0
+        ) {
+            my $path = readlink($log_path);
+            my ($date) = $path =~ qr{\.log\.(\d{8}\d*)\z}msx;
+            if ($date && $date > $date_p1w) {
+                $log_path_cur = catfile($project_path, 'log', $path);
+            }
+        }
+        # Create latest log, if necessary
+        if (!$log_path_cur) {
+            $log_path_cur = "$log_path.$today";
+            write_file($log_path_cur);
+        }
+        if (    !-e $log_path
+            ||  !-l $log_path
+            ||  readlink($log_path) ne basename($log_path_cur)
+        ) {
+            run_rmtree($log_path);
+            run_symlink(basename($log_path_cur), $log_path);
+        }
+        # Remove logs older than $keep_threshold
+        for my $path (
+            sort glob(catfile($project_path, 'log', $hook_name . '*.log.*'))
+        ) {
+            my ($date, $dot_gz) = $path =~ qr{\.log\.(\d{8}\d*)(\.gz)?\z}msx;
+            if (    $date && $date <= $date_p4w
+                ||  $date && $date <= $date_p1w && !-s $path
+            ) {
+                run_rmtree($path);
+            }
+            elsif ($date && $date <= $date_p1w && !$dot_gz) {
+                $RUNNER->run(
+                    "gzip $path",
+                    sub {gzip($path, "$path.gz") && unlink($path)},
+                );
+            }
+        }
+    }
+    my $group = $CONFIG->get_svn_group();
+    if ($group) {
+        _chgrp_and_chmod(catfile($project_path, 'log'), $group);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Installs hook scripts to a SVN project.
+sub install_svn_hook {
+    my ($project, $clean_mode) = @_;
+    # Write hook environment configuration
+    my $project_path = $project->get_svn_live_path();
+    my $conf_dest = catfile($project_path, qw{conf hooks-env});
+    write_file(
+        $conf_dest,
+        "[default]\n",
+        map {sprintf("%s=%s\n", @{$_});}
+        grep {$_->[1];} (
+            ['FCM_HOME', $CONFIG->get_fcm_home()],
+            ['FCM_SITE_HOME', $CONFIG->get_fcm_site_home()],
+            ['FCM_SVN_HOOK_ADMIN_EMAIL', $CONFIG->get_admin_email()],
+            ['FCM_SVN_HOOK_COMMIT_DUMP_DIR', $CONFIG->get_svn_dump_dir()],
+            ['FCM_SVN_HOOK_NOTIFICATION_FROM', $CONFIG->get_notification_from()],
+            ['FCM_SVN_HOOK_REPOS_SUFFIX', $CONFIG->get_svn_project_suffix()],
+            ['FCM_SVN_HOOK_TRAC_ROOT_DIR', $CONFIG->get_trac_live_dir()],
+            ['PATH', $CONFIG->get_svn_hook_path_env()],
+            ['TZ', 'UTC'],
+        )
+    );
+    my %path_of = ();
+    # Search for hook scripts:
+    # * default sets
+    # * selected items from top of repository, e.g. svnperms.conf
+    # * site overrides
+    _get_files_from(
+        catfile($CONFIG->get_fcm_home(), 'etc', 'svn-hooks'),
+        sub {
+            my ($base_name, $path) = @_;
+            if (index($base_name, q{.}) == 0 || -d $path) {
+                return;
+            }
+            $path_of{$base_name} = $path;
+        },
+    );
+    for my $line (qx{svnlook tree -N $project_path}) {
+        chomp($line);
+        my ($base_name) = $line =~ qr{\A\s*(.*)\z}msx;
+        if (grep {$_ eq $base_name} @SVN_REPOS_ROOT_HOOK_ITEMS) {
+            $path_of{$base_name} = "^/$base_name";
+        }
+    }
+    _get_files_from(
+        catfile(
+            $CONFIG->get_fcm_site_home(), 'svn-hooks', $project->get_name(),
+        ),
+        sub {
+            my ($base_name, $path) = @_;
+            if (index($base_name, q{.}) == 0 || -d $path) {
+                return;
+            }
+            $path_of{$base_name} = $path;
+        },
+    );
+    # Install hook scripts and associated files
+    for my $base_name (sort keys(%path_of)) {
+        my $hook_source = $path_of{$base_name};
+        my $hook_dest = catfile($project->get_svn_live_hook_path(), $base_name);
+        if (index($hook_source, '^/') == 0) {
+            $RUNNER->run(
+                "install $hook_dest <- $hook_source",
+                sub {
+                    my $source = "file://$project_path/$base_name";
+                    !system(qw{svn export -q --force}, $source, $hook_dest)
+                        || die("\n");
+                    chmod((stat($hook_dest))[2] | S_IRGRP | S_IROTH, $hook_dest);
+                },
+            );
+        }
+        else {
+            run_copy($hook_source, $hook_dest);
+        }
+    }
+    # Clean hook destination, if necessary
+    if ($clean_mode) {
+        my $hook_path = $project->get_svn_live_hook_path();
+        for my $path (sort glob(catfile($hook_path, q{*}))) {
+            if (!exists($path_of{basename($path)})) {
+                run_rmtree($path);
+            }
+        }
+    }
+    my $group = $CONFIG->get_svn_group();
+    if ($group) {
+        _chgrp_and_chmod($project->get_svn_live_hook_path(), $group);
+    }
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Updates the SVN password file.
+sub manage_users_in_svn_passwd {
+    my ($user_ref) = @_;
+    if (!$CONFIG->get_svn_passwd_file()) {
+        return 1;
+    }
+    my $svn_passwd_file = catfile(
+        $CONFIG->get_svn_live_dir(),
+        $CONFIG->get_svn_passwd_file(),
+    );
+    $RUNNER->run(
+        "updating $svn_passwd_file",
+        sub {
+            my $USERS_SECTION = q{users};
+            my $svn_passwd_ini;
+            my $is_changed;
+            if (-f $svn_passwd_file) {
+                $svn_passwd_ini
+                    = Config::IniFiles->new(q{-file} => $svn_passwd_file);
+            }
+            else {
+                $svn_passwd_ini = Config::IniFiles->new();
+                $svn_passwd_ini->SetFileName($svn_passwd_file);
+                $svn_passwd_ini->AddSection($USERS_SECTION);
+                $is_changed = 1;
+            }
+            for my $name (($svn_passwd_ini->Parameters($USERS_SECTION))) {
+                if (!exists($user_ref->{$name})) {
+                    $RUNNER->run(
+                        "removing $name from $svn_passwd_file",
+                        sub {
+                            return
+                                $svn_passwd_ini->delval($USERS_SECTION, $name);
+                        },
+                    );
+                    $is_changed = 1;
+                }
+            }
+            for my $user (values(%{$user_ref})) {
+                if (!defined($svn_passwd_ini->val($USERS_SECTION, "$user"))) {
+                    $RUNNER->run(
+                        "adding $user to $svn_passwd_file",
+                        sub {
+                            $svn_passwd_ini->newval(
+                                $USERS_SECTION, $user->get_name(), q{},
+                            ),
+                        },
+                    );
+                    $is_changed = 1;
+                }
+            }
+            return ($is_changed ? $svn_passwd_ini->RewriteConfig() : 1);
+        },
+    );
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Updates the Trac password file.
+sub manage_users_in_trac_passwd {
+    my ($user_ref) = @_;
+    if (!$CONFIG->get_trac_passwd_file()) {
+        return 1;
+    }
+    my $trac_passwd_file = catfile(
+        $CONFIG->get_trac_live_dir(),
+        $CONFIG->get_trac_passwd_file(),
+    );
+    $RUNNER->run(
+        "updating $trac_passwd_file",
+        sub {
+            my %old_names;
+            my %new_names = %{$user_ref};
+            if (-f $trac_passwd_file) {
+                read_file(
+                    $trac_passwd_file,
+                    sub {
+                        my ($line) = @_;
+                        chomp($line);
+                        if (
+                            !$line || $line =~ qr{\A\s*\z}xms # blank line
+                            || $line =~ qr{\A\s*\#}xms        # comment line
+                        ) {
+                            return;
+                        }
+                        my ($name, $passwd) = split(qr{\s*:\s*}xms, $line);
+                        if (exists($new_names{$name})) {
+                            delete($new_names{$name});
+                        }
+                        else {
+                            $old_names{$name} = 1;
+                        }
+                    },
+                ) || return;
+            }
+            else {
+                write_file($trac_passwd_file) || return;
+            }
+            if (%old_names || %new_names) {
+                for my $name (keys(%old_names)) {
+                    $RUNNER->run(
+                        "removing $name from $trac_passwd_file",
+                        sub {
+                            return !system(
+                                qw{htpasswd -D}, $trac_passwd_file, $name,
+                            );
+                        },
+                    );
+                }
+                for my $name (keys(%new_names)) {
+                    $RUNNER->run(
+                        "adding $name to $trac_passwd_file",
+                        sub {
+                            return !system(
+                                qw{htpasswd -b}, $trac_passwd_file, $name, q{},
+                            );
+                        },
+                    );
+                    sleep(1); # ensure the random seed for htpasswd is changed
+                }
+            }
+            return 1;
+        },
+        # Note: can use HTTPD::UserAdmin, if it is installed
+    );
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Manages the session* tables in the DB of a Trac environment.
+sub manage_users_in_trac_db_of {
+    my ($project, $user_ref) = @_;
+    return $RUNNER->run_with_retries(
+        sprintf(
+            qq{checking/updating %s},
+            $project->get_trac_live_db_path(),
+        ),
+        sub {return _manage_users_in_trac_db_of($project, $user_ref)},
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Recovers a SVN repository from its backup.
+sub recover_svn_repository {
+    my ($project, $recover_dumps_option, $recover_hooks_option) = @_;
+    if (-e $project->get_svn_live_path()) {
+        die(sprintf(
+            "%s: live repository exists.\n",
+            $project->get_svn_live_path(),
+        ));
+    }
+    run_mkpath($CONFIG->get_svn_live_dir());
+    my $base_name = $project->get_svn_base_name();
+    my $work_dir = tempdir(
+        qq{$base_name.XXXXXX},
+        DIR => $CONFIG->get_svn_live_dir(),
+        CLEANUP => 1,
+    );
+    my $work_path = catfile($work_dir, $base_name);
+    _extract_backup_archive($project->get_svn_backup_path(), $work_path);
+    if ($recover_dumps_option) {
+        my $youngest = _svnlook_youngest($work_path);
+        my %dump_path_of;
+        _get_files_from(
+            $CONFIG->get_svn_dump_dir(),
+            sub {
+                my ($dump_base_name, $path) = @_;
+                my ($name, $rev) = $dump_base_name =~ qr{\A(.*)-(\d+)\.gz\z}msx;
+                if (    !$name
+                    ||  !$rev
+                    ||  $name ne $base_name
+                    ||  $rev <= $youngest
+                ) {
+                    return;
+                }
+                $dump_path_of{$rev} = $path;
+            },
+        );
+        for my $rev (sort {$a <=> $b} keys(%dump_path_of)) {
+            my $dump_path = $dump_path_of{$rev};
+            $RUNNER->run(
+                "loading $dump_path into $work_path",
+                sub {
+                    my $pipe = IO::Pipe->new();
+                    $pipe->writer(qw{svnadmin load}, $work_path);
+                    my $handle = IO::Zlib->new($dump_path, 'rb');
+                    if (!$handle) {
+                        die("$dump_path: $!\n");
+                    }
+                    while ($handle->read(my $buffer, $BUFFER_SIZE)) {
+                        $pipe->print($buffer);
+                    }
+                    $handle->close();
+                    return ($pipe->close());
+                },
+            );
+        }
+    }
+    run_rename($work_path, $project->get_svn_live_path());
+    my $group = $CONFIG->get_svn_group();
+    if ($group) {
+        _chgrp_and_chmod($project->get_svn_live_path(), $group);
+    }
+    if ($recover_hooks_option) {
+        install_svn_hook($project);
+        housekeep_svn_hook_logs($project);
+    }
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Recovers a Trac environment from its backup.
+sub recover_trac_environment {
+    my ($project) = @_;
+    if (-e $project->get_trac_live_path()) {
+        die(sprintf(
+            "%s: live environment exists.\n",
+            $project->get_trac_live_path(),
+        ));
+    }
+    run_mkpath($CONFIG->get_trac_live_dir());
+    my $base_name = $project->get_name();
+    my $work_dir = tempdir(
+        qq{$base_name.XXXXXX},
+        DIR => $CONFIG->get_trac_live_dir(),
+        CLEANUP => 1,
+    );
+    my $work_path = catfile($work_dir, $base_name);
+    _extract_backup_archive($project->get_trac_backup_path(), $work_path);
+    run_rename($work_path, $project->get_trac_live_path());
+    my $group = $CONFIG->get_trac_group();
+    if ($group) {
+        _chgrp_and_chmod($project->get_trac_live_path(), $group);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Recover a file from the Trac backup directory to the Trac live directory.
+sub recover_trac_files {
+    # (no argument)
+    _copy_files(
+        $CONFIG->get_trac_backup_dir(),
+        $CONFIG->get_trac_live_dir(),
+        $NO_OVERWRITE,
+        qr{\.tgz\z}msx,
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Vacuum the database of a Trac environment.
+sub vacuum_trac_env_db {
+    my ($project) = @_;
+    $RUNNER->run(
+        "performing vacuum on database of Trac environment for $project",
+        sub {
+            my $db_handle = _get_trac_db_handle_for($project);
+            if (!$db_handle) {
+                return;
+            }
+            $db_handle->do(q{vacuum;}) && $db_handle->disconnect();
+        },
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Verify users. Return a list of bad users from @users.
+sub verify_users {
+    my @users = @_;
+    if (!defined($USER_INFO_TOOL)) {
+        my $name = $CONFIG->get_user_info_tool();
+        my $class = $UTIL->class_load($USER_INFO_TOOL_OF{$name});
+        $USER_INFO_TOOL = $class->new({util => $UTIL});
+    }
+    return $USER_INFO_TOOL->verify_users(@users);
+}
+
+# ------------------------------------------------------------------------------
+# Changes/restores ownership and permission of a given $path to a given $group.
+sub _chgrp_and_chmod {
+    my ($path, $group) = @_;
+    my $gid = $group ? scalar(getgrnam($group)) : -1;
+    find(
+        sub {
+            my $file = $File::Find::name;
+            my $old_gid = (stat($file))[5];
+            if ($old_gid != $gid) {
+                $RUNNER->run(
+                    "changing group ownership for $file",
+                    sub {return chown(-1, $gid, $file)},
+                );
+            }
+            my $old_mode = (stat($file))[2];
+            my $mode = (stat($file))[2] | S_IRGRP | S_IWGRP;
+            if ($old_mode != $mode) {
+                $RUNNER->run(
+                    "adding group write permission for $file",
+                    sub {return chmod($mode, $file)},
+                );
+            }
+        },
+        $path,
+    );
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Copies files immediately under $source to $target.
+sub _copy_files {
+    my ($source, $target, $no_overwrite, $re_skip) = @_;
+    my @bases;
+    opendir(my $handle, $source) || die("$source: $!\n");
+    while (my $base = readdir($handle)) {
+        if (-f catfile($source, $base)) {
+            if ($no_overwrite && -f catfile($target, $base)) {
+                warn("[SKIP] $base: already exists in $target.\n");
+            }
+            elsif (!$re_skip || ($base !~ $re_skip)) {
+                push(@bases, $base);
+            }
+        }
+    }
+    closedir($handle);
+    run_mkpath($target);
+    for my $base (@bases) {
+        run_copy(map {catfile($_, $base)} ($source, $target));
+    }
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Creates backup archive from a path.
+sub _create_backup_archive {
+    my ($source_path, $backup_dir, $archive_base_name) = @_;
+    my $source_dir = dirname($source_path);
+    my $source_base_name = basename($source_path);
+    run_mkpath($backup_dir);
+    my ($fh, $work_backup_path)
+        = tempfile(qq{$archive_base_name.XXXXXX}, DIR => $backup_dir);
+    close($fh);
+    run_create_archive($work_backup_path, $source_dir, $source_base_name);
+    my $backup_path = catfile($backup_dir, $archive_base_name);
+    run_rename($work_backup_path, $backup_path);
+    my $mode = (stat($backup_path))[2] | S_IRGRP | S_IROTH;
+    return chmod($mode, $backup_path);
+}
+
+# ------------------------------------------------------------------------------
+# Extracts from a backup archive to a work path.
+sub _extract_backup_archive {
+    my ($archive_path, $work_path) = @_;
+    run_extract_archive($archive_path, dirname($work_path));
+    if (! -e $work_path) {
+        my ($base_name) = basename($work_path);
+        die("$base_name: does not exist in archive $archive_path.\n");
+    }
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Searches a directory for files and invokes a callback on each file.
+sub _get_files_from {
+    my ($dir_path, $callback_ref) = @_;
+    my $dir_handle = IO::Dir->new($dir_path);
+    if (!defined($dir_handle)) {
+        return;
+    }
+    BASE_NAME:
+    while (my $base_name = $dir_handle->read()) {
+        my $path = catfile($dir_path, $base_name);
+        if (index($base_name, q{.}) == 0) {
+            next BASE_NAME;
+        }
+        $callback_ref->($base_name, $path);
+    }
+    return $dir_handle->close();
+}
+
+# ------------------------------------------------------------------------------
+# Returns a database handle for the database of a Trac environment.
+sub _get_trac_db_handle_for {
+    my ($project) = @_;
+    my $db_path = $project->get_trac_live_db_path();
+    return DBI->connect(qq{dbi:SQLite:dbname=$db_path}, q{}, q{});
+}
+
+# ------------------------------------------------------------------------------
+# Manages the session* tables in the DB of a Trac environment.
+sub _manage_users_in_trac_db_of {
+    my ($project, $user_ref) = @_;
+    my $db_handle = _get_trac_db_handle_for($project);
+    if (!$db_handle) {
+        return;
+    }
+    SESSION: {
+        my $session_select_statement = $db_handle->prepare(
+            "SELECT sid FROM session WHERE authenticated == 1",
+        );
+        my $session_insert_statement = $db_handle->prepare(
+            "INSERT INTO session VALUES (?, 1, 0)",
+        );
+        my $session_delete_statement = $db_handle->prepare(
+            "DELETE FROM session WHERE sid == ?",
+        );
+        $session_select_statement->execute();
+        my $is_changed = 0;
+        my %session_old_users;
+        while (my ($sid) = $session_select_statement->fetchrow_array()) {
+            if (exists($user_ref->{$sid})) {
+                $session_old_users{$sid} = 1;
+            }
+            else {
+                $RUNNER->run(
+                    "session: removing $sid",
+                    sub{return $session_delete_statement->execute($sid)},
+                );
+                $is_changed = 1;
+            }
+        }
+        for my $sid (keys(%{$user_ref})) {
+            if (!exists($session_old_users{$sid})) {
+                $RUNNER->run(
+                    "session: adding $sid",
+                    sub {return $session_insert_statement->execute($sid)},
+                );
+                $is_changed = 1;
+            }
+        }
+        $session_select_statement->finish();
+        $session_insert_statement->finish();
+        $session_delete_statement->finish();
+    }
+    SESSION_ATTRIBUTE: {
+        my $attribute_select_statement = $db_handle->prepare(
+            "SELECT sid,name,value FROM session_attribute "
+                . "WHERE authenticated == 1",
+        );
+        my $attribute_insert_statement = $db_handle->prepare(
+            "INSERT INTO session_attribute VALUES (?, 1, ?, ?)",
+        );
+        my $attribute_update_statement = $db_handle->prepare(
+            "UPDATE session_attribute SET value = ? "
+                . "WHERE sid = ? AND authenticated == 1 AND name == ?",
+        );
+        my $attribute_delete_statement = $db_handle->prepare(
+            "DELETE FROM session_attribute WHERE sid == ?",
+        );
+        my $attribute_delete_name_statement = $db_handle->prepare(
+            "DELETE FROM session_attribute WHERE sid == ? AND name == ?",
+        );
+        $attribute_select_statement->execute();
+        my %attribute_old_users;
+        my %deleted_users;
+        ROW:
+        while (my @row = $attribute_select_statement->fetchrow_array()) {
+            my ($sid, $name, $value) = @row;
+            my $user = exists($user_ref->{$sid})? $user_ref->{$sid} : undef;
+            if (defined($user)) {
+                my $getter
+                    = $name eq 'name'  ? 'get_display_name'
+                    : $name eq 'email' ? 'get_email'
+                    :                    undef;
+                if (!defined($getter)) {
+                    next ROW;
+                }
+                $attribute_old_users{"$sid|$name"} = 1;
+                my $new_value = $user->$getter();
+                if ($new_value && $new_value ne $value) {
+                    $RUNNER->run(
+                        "session_attribute: updating $name: $sid: $new_value",
+                        sub {return $attribute_update_statement->execute(
+                            $new_value, $sid, $name,
+                        )},
+                    );
+                }
+                elsif (!$new_value && $value) {
+                    $RUNNER->run(
+                        "session_attribute: removing $name: $sid",
+                        sub {return $attribute_delete_name_statement->execute(
+                            $sid, $name,
+                        )},
+                    );
+                }
+            }
+            elsif (!exists($deleted_users{$sid})) {
+                $deleted_users{$sid} = 1;
+                $RUNNER->run(
+                    "session_attribute: removing $sid",
+                    sub {return $attribute_delete_statement->execute($sid)},
+                );
+            }
+        }
+        for my $sid (keys(%{$user_ref})) {
+            my $user = $user_ref->{$sid};
+            ATTRIB:
+            for (
+                ['name' , $user->get_display_name()],
+                ['email', $user->get_email()       ],
+            ) {
+                my ($name, $value) = @{$_};
+                if (exists($attribute_old_users{"$sid|$name"})) {
+                    next ATTRIB;
+                }
+                if ($value) {
+                    $RUNNER->run(
+                        "session_attribute: adding $name: $sid: $value",
+                        sub {$attribute_insert_statement->execute(
+                            $sid, $name, $value,
+                        )},
+                    );
+                }
+            }
+        }
+        $attribute_select_statement->finish();
+        $attribute_insert_statement->finish();
+        $attribute_update_statement->finish();
+        $attribute_delete_statement->finish();
+    }
+    return $db_handle->disconnect();
+}
+
+# ------------------------------------------------------------------------------
+# Returns the youngest revision of a SVN repository.
+sub _svnlook_youngest {
+    my ($svn_repos_path) = @_;
+    my ($youngest) = qx{svnlook youngest $svn_repos_path};
+    chomp($youngest);
+    return $youngest;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::Admin::System
+
+=head1 SYNOPSIS
+
+    use FCM::Admin::System qw{ ... };
+    # ... see descriptions of individual functions for detail
+
+=head1 DESCRIPTION
+
+This module contains utility functions for the administration of Subversion
+repositories and Trac environments hosted by the FCM team.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item add_svn_repository($project_name)
+
+Creates a new Subversion repository.
+
+=item add_trac_environment($project_name)
+
+Creates a new Trac environment.
+
+=item backup_svn_repository(\%option,$project)
+
+Creates an archived hotcopy of $project's live SVN repository, and put it in the
+SVN backup directory. If $option{'no-verify-integrity'} does not exist, it
+verifies the integrity of the live repository before creating the hotcopy. If
+$option{'no-pack'} does not exist, it packs the live repository before creating
+the hotcopy. If $option{'no-housekeep-dumps'} does not exist, it housekeeps the
+revision dumps of $project following a successful backup.
+
+$project should be a L<FCM::Admin::Project|FCM::Admin::Project> object.
+
+=item backup_trac_environment(\%option,$project)
+
+Creates an archived hotcopy of $project's live Trac environment, and put it in
+the Trac backup directory. If $option{'no-verify-integrity'} does not exist, it
+verifies the integrity of the database of the live environment before creating
+the hotcopy.
+
+$project should be a L<FCM::Admin::Project|FCM::Admin::Project> object.
+
+=item backup_trac_files()
+
+Copies regular files immediately under the live Trac directory to the Trac
+backup directory.
+
+=item distribute_wc()
+
+Distributes the central FCM working copy to standard locations.
+
+=item filter_projects($project_list_ref,$filter_list_ref)
+
+Filters the project list in $project_list_ref using a list of names in
+$filter_list_ref. Returns a list of projects with names matching those in
+$filter_list_ref. Returns the full list if $filter_list_ref points to an empty
+list.
+
+=item get_projects_from_svn_backup()
+
+Returns a list of L<FCM::Admin::Project|FCM::Admin::Project> objects by
+searching the SVN backup directory. By default, all valid projects are returned.
+
+=item get_projects_from_svn_live()
+
+Similar to get_projects_from_svn_backup(), but it searches the SVN live
+directory.
+
+=item get_projects_from_trac_backup()
+
+Similar to get_projects_from_svn_backup(), but it searches the Trac backup
+directory.
+
+=item get_projects_from_trac_live()
+
+Similar to get_projects_from_svn_backup(), but it searches the Trac live
+directory.
+
+=item get_users(@only_users)
+
+Retrieves a list of users. Store results in a HASH, {user ID => user info, ...}
+where each user info is stored in an instance of
+L<FCM::Admin::System::User|FCM::Admin::System::User>.
+
+If no argument, return all valid users. If @only_users, return only those users
+with matching user ID in @only_users.
+
+=item housekeep_svn_hook_logs($project)
+
+Housekeep logs generated by the hook scripts of the $project's SVN live
+repository.
+
+$project should be a L<FCM::Admin::Project|FCM::Admin::Project> object.
+
+=item install_svn_hook($project, $clean_mode)
+
+Searches for hook scripts in the standard location and install them (as symbolic
+links) in the I<hooks> directory of the $project's SVN live repository.
+
+$project should be a L<FCM::Admin::Project|FCM::Admin::Project> object.
+
+If $clean_mode is specified and is true, remove any items in the I<hooks>
+directory that are not known to this install.
+
+=item manage_users_in_svn_passwd($user_ref)
+
+Using entries in the hash reference $user_ref, sets up or updates the SVN and
+Trac password files. The $user_ref argument should be a reference to a hash, as
+returned by get_users().
+
+=item manage_users_in_trac_passwd($user_ref)
+
+Using entries in the hash reference $user_ref, sets up or updates the Trac
+password files. The $user_ref argument should be a reference to a hash, as
+returned by get_users().
+
+=item manage_users_in_trac_db_of($project, $user_ref)
+
+Using entries in $user_ref, sets up or updates the session/session_attribute
+tables in the databases of the live Trac environments. The $project argument
+should be a L<FCM::Admin::Project|FCM::Admin::Project> object
+and $user_ref should be a reference to a hash, as returned by get_users().
+
+=item recover_svn_repository($project,$recover_dumps_option,$recover_hooks_option)
+
+Recovers a project's SVN repository using its backup. If $recover_dumps_option
+is set to true, it will also attempt to load the latest revision dumps following
+a successful recovery. If $recover_hooks_option is set to true, it will also
+attempt to re-install the hook scripts following a successful recovery.
+
+$project should be a L<FCM::Admin::Project|FCM::Admin::Project> object.
+
+=item recover_trac_environment($project)
+
+Recovers a project's Trac environment using its backup.
+
+$project should be a L<FCM::Admin::Project|FCM::Admin::Project> object.
+
+=item recover_trac_files()
+
+Copies files immediately under the backup Trac directory to the Trac live
+directory (if the files do not already exist).
+
+=item vacuum_trac_env_db($project)
+
+Connects to the database of a project's Trac environment, and issues the
+"VACUUM" SQL command.
+
+$project should be a L<FCM::Admin::Project|FCM::Admin::Project> object.
+
+=back
+
+=head1 SEE ALSO
+
+L<FCM::Admin::Config|FCM::Admin::Config>,
+L<FCM::Admin::Project|FCM::Admin::Project>,
+L<FCM::Admin::Runner|FCM::Admin::Runner>,
+L<FCM::Admin::User|FCM::Admin::User>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/User.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/User.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/User.pm	(revision 5095)
@@ -0,0 +1,90 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package FCM::Admin::User;
+use base qw{FCM::Class::HASH};
+use overload q{""} => \&get_name;
+
+__PACKAGE__->class({
+    name         => '$',
+    display_name => '$',
+    email        => '$',
+});
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::Admin::User
+
+=head1 SYNOPSIS
+
+    use FCM::Admin::User;
+    $user = FCM::Admin::User->new({name => 'bob'});
+    $user->set_display_name('Robert Smith');
+    $user->set_email('robert.smith@somewhere.org');
+
+=head1 DESCRIPTION
+
+An object of this class is used to store the data model of a user.
+
+=head1 METHODS
+
+=over 4
+
+=item FCM::Admin::User->new(\%arguments)
+
+Creates a new instance. The keys of the %argument hash may contain "name",
+"display_name", and/or "email".
+
+=item $user->get_name()
+
+Returns the name/ID of the user.
+
+=item $user->get_display_name()
+
+Returns the display name of the user.
+
+=item $user->get_email()
+
+Returns the e-mail address of the user.
+
+=item $user->set_name($value)
+
+Sets the name/ID of the user.
+
+=item $user->set_display_name($value)
+
+Sets the display name of the user.
+
+=item $user->set_email($value)
+
+Sets the e-mail address of the user.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Users/LDAP.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Users/LDAP.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Users/LDAP.pm	(revision 5095)
@@ -0,0 +1,149 @@
+
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package FCM::Admin::Users::LDAP;
+use base qw{FCM::Class::CODE};
+
+use FCM::Admin::Config;
+use FCM::Admin::User;
+use Net::LDAP;
+use Text::ParseWords qw{shellwords};
+
+my %ACTION_OF = (
+    get_users_info => \&_get_users_info,
+    verify_users   => \&_verify_users,
+);
+
+__PACKAGE__->class({util => '&'}, {action_of => {%ACTION_OF}});
+
+my $CONFIG = FCM::Admin::Config->instance();
+
+# Gets a HASH of users via LDAP.
+# %user_of = ($name => <FCM::Admin::User instance>, ...)
+sub _get_users_info {
+    my ($attrib_ref, @only_users) = @_;
+    my $res = _ldap_search($attrib_ref, undef, @only_users);
+    my ($uid_attr, $cn_attr, $mail_attr)
+        = shellwords($CONFIG->get_ldap_attrs());
+    my %user_of;
+    for my $entry ($res->entries()) {
+        my $name = $entry->get_value($uid_attr);
+        my $display_name = $entry->get_value($cn_attr);
+        my $email = $entry->get_value($mail_attr);
+        if ($display_name && $email) {
+            $user_of{$name} = FCM::Admin::User->new({
+                name         => $name,
+                display_name => $display_name,
+                email        => $email,
+            });
+        }
+    }
+    return \%user_of;
+}
+
+# Return a list of bad users.
+sub _verify_users {
+    my ($attrib_ref, @users) = @_;
+    my $res = _ldap_search($attrib_ref, 0, @users); # 0 == $uid_attr
+    my ($uid_attr, $cn_attr, $mail_attr)
+        = shellwords($CONFIG->get_ldap_attrs());
+    my %bad_users = map {($_ => 1)} @users;
+    for my $entry ($res->entries()) {
+        my $name = $entry->get_value($uid_attr);
+        if (exists($bad_users{$name})) {
+            delete($bad_users{$name});
+        }
+    }
+    return sort(keys(%bad_users));
+}
+
+# Bind to the LDAP server. Return a Net::LDAP instance.
+sub _ldap_search {
+    my ($attrib_ref, $attr_index, @users) = @_;
+
+    my $ldap_uri = $CONFIG->get_ldap_uri();
+    my $ldap = Net::LDAP->new($CONFIG->get_ldap_uri());
+    my $password_file = $CONFIG->get_ldappw();
+    $password_file = $attrib_ref->{util}->file_tilde_expand($password_file);
+    my $password = $password_file
+        ? $attrib_ref->{util}->file_load($password_file)
+        : undef;
+    my %ldap_options = $password ? (password => $password) : ();
+    $ldap->bind($CONFIG->get_ldap_binddn(), %ldap_options);
+
+    my @attrs = shellwords($CONFIG->get_ldap_attrs());
+    my ($uid_attr) = @attrs;
+    my $filter = @users
+        ? "(|($uid_attr=" . join(")($uid_attr=", @users) . '))'
+        : "(&($uid_attr=*))";
+    my $ldap_filter_more = $CONFIG->get_ldap_filter_more();
+    if ($ldap_filter_more) {
+        $filter = '(&' . $filter . $ldap_filter_more . ')';
+    }
+    my $res = $ldap->search(
+        base   => $CONFIG->get_ldap_basedn(),
+        filter => $filter,
+        attrs  => [$attr_index ? ($attrs[$attr_index]) : @attrs],
+    );
+    $ldap->unbind();
+    return $res;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::Admin::Users::LDAP
+
+=head1 SYNOPSIS
+
+    use FCM::Admin::Users::LDAP;
+    my $users_info_util = FCM::Admin::Users::LDAP->new();
+    $users_info_util->get_users();
+
+=head1 DESCRIPTION
+
+Utility for obtaining user information via LDAP.
+
+=head1 METHODS
+
+=over 4
+
+=item $util->get_users_info()
+
+Return a HASH (in list context) or a reference to a HASH (in scalar context)
+{name => <FCM::Admin::User instance>, ...}. The HASH should contain all entries
+in the passwd database that appear to be real users.
+
+=item $util->verify_users(@users)
+
+Return a list of bad users in @users.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Users/Passwd.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Users/Passwd.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Users/Passwd.pm	(revision 5095)
@@ -0,0 +1,145 @@
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package FCM::Admin::Users::Passwd;
+use base qw{FCM::Class::CODE};
+
+use FCM::Admin::Config;
+use FCM::Admin::User;
+use Text::ParseWords qw{shellwords};
+
+my %ACTION_OF = (
+    get_users_info => \&_get_users_info,
+    verify_users   => \&_verify_users,
+);
+
+__PACKAGE__->class({}, {action_of => {%ACTION_OF}});
+
+my $CONFIG = FCM::Admin::Config->instance();
+
+# Gets a HASH of users using the POSIX password DB.
+# %user_of = ($name => <FCM::Admin::User instance>, ...)
+sub _get_users_info {
+    my ($attrib_ref, @only_users) = @_;
+    if (@only_users) {
+        return _get_only_users_info($attrib_ref, @only_users);
+    }
+    my $gid_max = $CONFIG->get_passwd_gid_max();
+    my $uid_max = $CONFIG->get_passwd_uid_max();
+    my $gid_min = $CONFIG->get_passwd_gid_min();
+    my $uid_min = $CONFIG->get_passwd_uid_min();
+    my %user_of;
+    USER:
+    while (my ($name, $uid, $gid, $gecos) = (getpwent())[0, 2, 3, 6]) {
+        if (    exists($user_of{$name})
+            ||  defined($uid_max) && $uid > $uid_max || $uid < $uid_min
+            ||  defined($gid_max) && $gid > $gid_max || $gid < $gid_min
+            ||  !$gecos
+            ||  (@only_users && grep {$_ eq $name} @only_users)
+        ) {
+            next USER;
+        }
+        my $email = _guess_email_from_gecos($attrib_ref, $gecos);
+        if (!$email) {
+            next USER;
+        }
+        $user_of{$name} = FCM::Admin::User->new({
+            name         => $name,
+            display_name => (split(q{,}, $gecos))[0],
+            email        => $email,
+        });
+    }
+    endpwent();
+    return \%user_of;
+}
+
+# Gets a HASH of users matching @only_users using the POSIX password DB.
+# %user_of = ($name => <FCM::Admin::User instance>, ...)
+sub _get_only_users_info {
+    my ($attrib_ref, @only_users) = @_;
+    my %user_of;
+    for my $user (@only_users) {
+        my ($name, $gecos) = (getpwnam($user))[0, 6];
+        if ($name && $gecos) {
+            $user_of{$name} = FCM::Admin::User->new({
+                name         => $name,
+                display_name => (split(q{,}, $gecos))[0],
+                email        => _guess_email_from_gecos($attrib_ref, $gecos),
+            });
+        }
+    }
+    return (wantarray() ? %user_of : \%user_of);
+}
+
+# Guess a user's email from gecos information
+sub _guess_email_from_gecos {
+    my ($attrib_ref, $gecos) = @_;
+    my $domain = $CONFIG->get_passwd_email_domain();
+    my $name = index($gecos, q{,}) > 0 ? (split(q{,}, $gecos))[0] : $gecos;
+    return ($name =~ qr{\s}msx)
+        ? undef : lc($name) . ($domain ? '@' . $domain : q{});
+}
+
+# Return a list of bad users in @users.
+sub _verify_users {
+    my ($attrib_ref, @users) = @_;
+    grep {!getpwnam($_)} @users;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::Admin::Users::Passwd
+
+=head1 SYNOPSIS
+
+    use FCM::Admin::Users::Passwd;
+    my $users_info_util = FCM::Admin::Users::Passwd->new();
+    $users_info_util->get_users();
+
+=head1 DESCRIPTION
+
+Utility for obtaining user information from passwd information.
+
+=head1 METHODS
+
+=over 4
+
+=item $util->get_users_info()
+
+Return a HASH (in list context) or a reference to a HASH (in scalar context)
+{name => <FCM::Admin::User instance>, ...}. The HASH should contain all entries
+in the passwd database that appear to be real users.
+
+=item $util->verify_users(@users)
+
+Return a list of bad users in @users.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Util.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Util.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Admin/Util.pm	(revision 5095)
@@ -0,0 +1,385 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package FCM::Admin::Util;
+
+use Exporter qw{import};
+use FCM::Admin::Config;
+use FCM::Admin::Runner;
+use File::Basename qw{dirname};
+use File::Copy qw{copy};
+use File::Path qw{mkpath rmtree};
+use IO::File;
+use SVN::Client;
+
+our @EXPORT_OK = qw{
+    option2config
+    read_file
+    run_copy
+    run_create_archive
+    run_extract_archive
+    run_mkpath
+    run_rename
+    run_rmtree
+    run_rsync
+    run_svn_info
+    run_svn_update
+    run_symlink
+    sed_file
+    write_file
+};
+
+my @HTML2PS = qw{html2ps -n -U -W b};
+my @PS2PDF  = qw{
+    ps2pdf
+    -dMaxSubsetPct=100
+    -dCompatibilityLevel=1.3
+    -dSubsetFonts=true
+    -dEmbedAllFonts=true
+    -dAutoFilterColorImages=false
+    -dAutoFilterGrayImages=false
+    -dColorImageFilter=/FlateEncode
+    -dGrayImageFilter=/FlateEncode
+    -dMonoImageFilter=/FlateEncode
+    -sPAPERSIZE=a4
+};
+
+# ------------------------------------------------------------------------------
+# Loads values of an option hash into the configuration.
+sub option2config {
+    my ($option_ref) = @_;
+    my $config = FCM::Admin::Config->instance();
+    for my $key (keys(%{$option_ref})) {
+        my $method = $key;
+        $method =~ s{-}{_}gxms;
+        $method = "set_$method";
+        if ($config->can($method)) {
+            $config->$method($option_ref->{$key});
+        }
+    }
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Reads lines from a file.
+sub read_file {
+    my ($path, $sub_ref) = @_;
+    my $file = IO::File->new($path);
+    if (!defined($file)) {
+        die("$path: cannot open for reading ($!).\n");
+    }
+    while (my $line = $file->getline()) {
+        $sub_ref->($line);
+    }
+    $file->close() || die("$path: cannot close for reading ($!).\n");
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Runs copy with checks and diagnostics.
+sub run_copy {
+    my ($source_path, $dest_path) = @_;
+    FCM::Admin::Runner->instance()->run(
+        "copy $source_path to $dest_path",
+        sub {
+            my $mode = (stat($source_path))[2];
+            my $rc = copy($source_path, $dest_path) && chmod($mode, $dest_path);
+            if (!$rc) {
+                die($!);
+            }
+            return $rc;
+        },
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Creates a TAR-GZIP archive.
+sub run_create_archive {
+    my ($archive_path, $work_dir, @base_names) = @_;
+    FCM::Admin::Runner->instance()->run(
+        "creating archive $archive_path",
+        sub {
+            my $command
+                = qq{tar -c -z -C '$work_dir' -f -}
+                . q{ } . join(q{ }, map {qq{'$_'}} @base_names)
+                . qq{ | dd 'conv=fsync' 'of=$archive_path'};
+            return !system($command);
+            # Note: can use Archive::Tar, but "tar" is much faster.
+        },
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Extracts from a TAR-GZIP archive.
+sub run_extract_archive {
+    my ($archive_path, $work_dir) = @_;
+    FCM::Admin::Runner->instance()->run(
+        "extracting archive $archive_path",
+        sub {
+            return !system(
+                qw{tar -x -z},
+                q{-C} => $work_dir,
+                q{-f} => $archive_path,
+            );
+            # Note: can use Archive::Tar, but "tar" is much faster.
+        },
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Runs mkpath with checks and diagnostics.
+sub run_mkpath {
+    my ($path) = @_;
+    if (!-d $path) {
+        FCM::Admin::Runner->instance()->run(
+            "creating $path",
+            sub {return mkpath($path)},
+        );
+    }
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Runs rename with checks and diagnostics.
+sub run_rename {
+    my ($source_path, $dest_path) = @_;
+    FCM::Admin::Runner->instance()->run(
+        "renaming $source_path to $dest_path",
+        sub {
+            run_mkpath(dirname($dest_path));
+            my $rc = rename($source_path, $dest_path);
+            if (!$rc) {
+                die($!);
+            }
+            return $rc;
+        },
+    );
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Runs rmtree with checks and diagnostics.
+sub run_rmtree {
+    my ($path) = @_;
+    if (-e $path) {
+        FCM::Admin::Runner->instance()->run(
+            "removing $path",
+            sub {
+                rmtree($path);
+                return !-e $path;
+            },
+        );
+    }
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Runs rsync.
+sub run_rsync {
+    my ($sources_ref, $dest_path, $option_list_ref) = @_;
+    FCM::Admin::Runner->instance()->run(
+        sprintf('mirroring %s <- %s', $dest_path, join(q{ }, @{$sources_ref})),
+        sub {return !system(
+            q{rsync},
+            ($option_list_ref ? @{$option_list_ref} : ()),
+            @{$sources_ref},
+            $dest_path,
+        )},
+    );
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Runs "svn info".
+sub run_svn_info {
+    my ($path) = @_;
+    my $return;
+    my $ctx = SVN::Client->new();
+    $ctx->info($path, undef, 'WORKING', sub {$return = $_[1]}, 0);
+    return $return;
+}
+
+# ------------------------------------------------------------------------------
+# Runs "svn update".
+sub run_svn_update {
+    my ($path) = @_;
+    my @return;
+    my $ctx = SVN::Client->new(
+        notify => sub {
+            if ($path ne $_[0]) {
+                push(@return, $_[0]);
+            }
+        }
+    );
+    $ctx->update($path, 'HEAD', 1);
+    return @return;
+}
+
+# ------------------------------------------------------------------------------
+# Runs symlink with checks and diagnostics.
+sub run_symlink {
+    my ($source_path, $dest_path) = @_;
+    FCM::Admin::Runner->instance()->run(
+        "creating symlink: $source_path -> $dest_path",
+        sub {
+            my $rc = symlink($source_path, $dest_path);
+            if (!$rc) {
+                die($!);
+            }
+            return $rc;
+        },
+    );
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# Edits content of a file.
+sub sed_file {
+    my ($path, $sub_ref) = @_;
+    my @lines;
+    read_file(
+        $path,
+        sub {
+            my ($line) = @_;
+            $line = $sub_ref->($line);
+            push(@lines, $line);
+        },
+    );
+    write_file($path, @lines);
+}
+
+# ------------------------------------------------------------------------------
+# Writes content to a file.
+sub write_file {
+    my ($path, @contents) = @_;
+    mkpath(dirname($path));
+    my $file = IO::File->new($path, q{w});
+    if (!defined($file)) {
+        die("$path: cannot open for writing ($!).\n");
+    }
+    for my $content (@contents) {
+        $file->print($content);
+    }
+    $file->close() || die("$path: cannot close for writing ($!).\n");
+    return 1;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::Admin::Util
+
+=head1 SYNOPSIS
+
+    use FCM::Admin::Util qw{ ... };
+    # ... see descriptions of individual functions for detail
+
+=head1 DESCRIPTION
+
+This module contains utility functions for the administration of Subversion
+repositories and Trac environments hosted by the FCM team.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item option2config($option_ref)
+
+Loads the values of an option hash into
+L<FCM::Admin::Config|FCM::Admin::Config>.
+
+=item read_file($path,$sub_ref)
+
+Reads from $path. For each $line the file, calls $sub_ref->($line).
+
+=item run_copy($source_path,$dest_path)
+
+Copies $source_path to $dest_path, with diagnostic.
+
+=item run_create_archive($archive_path,$work_dir,@base_names)
+
+Creates a TAR-GZIP archive at $archive_path using $work_dir as the working
+directory and @base_names as members of the archive. Depends on GNU "tar" or
+compatible.
+
+=item run_extract_archive($archive_path,$work_dir)
+
+Extracts a TAR-GZIP archive at $archive_path using $work_dir as the working
+directory. Depends on GNU "tar" or compatible.
+
+=item run_mkpath($path)
+
+Creates $path if it does not already exist, with diagnostic.
+
+=item run_rename($source_path,$dest_path)
+
+Same as the core I<rename>, but with diagnostic.
+
+=item run_rmtree($path)
+
+Removes $path, with diagnostic.
+
+=item run_rsync(\@sources,$dest_path,$option_list_ref)
+
+Invokes the "rsync" shell command with diagnostics to mirror the paths in
+@sources to $dest_path. Command line options can be specified in a list with
+$option_list_ref. Depends on "rsync".
+
+=item run_svn_info($path)
+
+Wrapper of the info() method of L<SVN::Client|SVN::Client>. Expects $path to be
+a Subversion working copy. Returns the C<svn_info_t> object as described by the
+info() method of L<SVN::Client|SVN::Client>.
+
+=item run_svn_update($path)
+
+Wrapper of the update() method of L<SVN::Client|SVN::Client>. Expects $path to be
+a Subversion working copy. Returns a list of updated paths.
+
+=item run_symlink($source_path,$dest_path)
+
+Same as the core I<symlink>, but with diagnostic.
+
+=item sed_file($path,$sub_ref)
+
+For each $line in $path, runs $line = $sub_ref->($line). Writes results back to
+$path.
+
+=item write_file($path,$content)
+
+Writes $content to $path.
+
+=back
+
+=head1 SEE ALSO
+
+L<FCM::Admin::Config|FCM::Admin::Config>,
+L<FCM::Admin::Runner|FCM::Admin::Runner>,
+L<SVN::Client|SVN::Client>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI.pm	(revision 5095)
@@ -0,0 +1,295 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::CLI;
+use base qw{FCM::Class::CODE};
+
+use FCM::CLI::Exception;
+use FCM::CLI::Parser;
+use FCM::Context::Event;
+use FCM::System;
+use FindBin;
+use File::Basename        qw{dirname};
+use File::Spec::Functions qw{catfile rel2abs};
+use Pod::Usage            qw{pod2usage};
+
+my $E = 'FCM::CLI::Exception';
+our $EVENT;
+our $S;
+our %ACTION_OF = (
+    # Commands handled by FCM
+    'add'           => _opt_func('check', sub {$S->cm_check_unknown(@_)}),
+    'branch'        => \&_branch,
+    'branch-create' => _sys_func(sub {$S->cm_branch_create(@_)}),
+    'branch-delete' => _sys_func(sub {$S->cm_branch_delete(@_)}),
+    'branch-diff'   => _sys_func(sub {$S->cm_branch_diff(@_)}),
+    'branch-info'   => _sys_func(sub {$S->cm_branch_info(@_)}),
+    'branch-list'   => _sys_func(sub {$S->cm_branch_list(@_)}),
+    'browse'        => _sys_func(sub {$S->browse(@_)}),
+    'build'         => _sys_func(sub {$S->build(@_)}),
+    'cfg-print'     => _sys_func(sub {$S->config_parse(@_)}),
+    'checkout'      => _sys_func(sub {$S->cm_checkout(@_)}),
+    'cmp-ext-cfg'   => _sys_func(sub {$S->config_compare(@_)}),
+    'commit'        => _sys_func(sub {$S->cm_commit(@_)}),
+    'conflicts'     => _sys_func(sub {$S->cm_resolve_conflicts(@_)}),
+    'delete'        => _opt_func('check', sub {$S->cm_check_missing(@_)}),
+    'diff'          => _opt_func(
+        'branch', sub {$S->cm_branch_diff(@_)}, sub {$S->cm_diff(@_)},
+    ),
+    'export-items'  => _sys_func(sub {$S->export_items(@_)}),
+    'extract'       => _sys_func(sub {$S->extract(@_)}),
+    'gui'           => \&_gui,
+    'help'          => \&_help,
+    'keyword-print' => _sys_func(sub {$S->keyword_find(@_)}),
+    'loc-layout'    => _sys_func(sub {$S->cm_loc_layout(@_)}),
+    'merge'         => _sys_func(sub {$S->cm_merge(@_)}),
+    'mkpatch'       => _sys_func(sub {$S->cm_mkpatch(@_)}),
+    'make'          => _sys_func(sub {$S->make(@_)}),
+    'project-create'=> _sys_func(sub {$S->cm_project_create(@_)}),
+    'switch'        => _opt_func(
+        'relocate', sub {$S->svn(@_)}, sub {$S->cm_switch(@_)},
+    ),
+    'test-battery'  => \&_test_battery,
+    'update'        => _sys_func(sub {$S->cm_update(@_)}),
+    'version'       => \&_version,
+    # Commands passed directly to "svn"
+    map {($_ => _sys_func())} qw{
+        blame
+        cat
+        cleanup
+        copy
+        export
+        import
+        info
+        list
+        lock
+        log
+        mergeinfo
+        mkdir
+        move
+        patch
+        propdel
+        propedit
+        propget
+        proplist
+        propset
+        relocate
+        resolve
+        resolved
+        revert
+        status
+        unlock
+        upgrade
+    },
+);
+# List of overridden subcommands that need to display "svn help"
+our %CLI_MORE_HELP_FOR = map {($_, 1)} (qw{add delete diff switch update});
+
+# Creates the class.
+__PACKAGE__->class(
+    {'gui' => '$', 'parser' => 'FCM::CLI::Parser', 'system' => 'FCM::System'},
+    {   init => sub {
+            my $attrib_ref = shift();
+            $attrib_ref->{parser} ||= FCM::CLI::Parser->new();
+            $attrib_ref->{system}
+                ||= FCM::System->new({'gui' => $attrib_ref->{'gui'}});
+        },
+        action_of => {main => \&_main},
+    },
+);
+
+# The main CLI action.
+sub _main {
+    my ($attrib_ref, @argv) = @_;
+    local($EVENT) = sub {$attrib_ref->{system}->util()->event(@_)};
+    my ($app, $option_ref, @args) = eval {$attrib_ref->{parser}->parse(@argv)};
+    if (my $e = $@) {
+        _err($attrib_ref, \@argv, $e);
+    }
+    if (!$app || $option_ref->{help}) {
+        return _help($attrib_ref, $app);
+    }
+    $option_ref ||= {};
+    my $q = $option_ref->{quiet}   || 0;
+    my $v = $option_ref->{verbose} || 0;
+    my $reporter = $attrib_ref->{system}->util()->util_of_report();
+    my $verbosity = $reporter->DEFAULT + $v - $q;
+    if (exists($ENV{FCM_DEBUG}) && $ENV{FCM_DEBUG} eq 'true') {
+        $verbosity = $reporter->DEBUG;
+    }
+    $reporter->get_ctx_of_stderr()->set_verbosity($verbosity);
+    $reporter->get_ctx_of_stdout()->set_verbosity($verbosity);
+    my @context = eval {
+        if (!exists($ACTION_OF{$app})) {
+            return $E->throw($E->APP, \@argv);
+        }
+        $ACTION_OF{$app}->($attrib_ref, $app, $option_ref, @args);
+    };
+    if (my $e = $@) {
+        return _err($attrib_ref, \@argv, $e);
+    }
+}
+
+# "fcm branch".
+sub _branch {
+    my ($attrib_ref, $app, $option_ref, @args) = @_;
+    my $method
+        = exists($option_ref->{create}) ? 'cm_branch_create'
+        : exists($option_ref->{delete}) ? 'cm_branch_delete'
+        : exists($option_ref->{list})   ? 'cm_branch_list'
+        :                                 'cm_branch_info'
+        ;
+    if ($option_ref->{create}) {
+        if (!$option_ref->{name}) {
+            return $E->throw($E->OPT, [$app, @args]);
+        }
+        my $name = delete($option_ref->{name});
+        unshift(@args, $name);
+    }
+    $attrib_ref->{system}->($method, $option_ref, @args);
+}
+
+# Handles FCM::Exception.
+sub _err {
+    my ($attrib_ref, $argv_ref, $e) = @_;
+    $EVENT->(FCM::Context::Event->E, $e) || die($e);
+    die("\n");
+}
+
+# "fcm gui".
+sub _gui {
+    my ($attrib_ref, $app, $option_ref, @args) = @_;
+    exec("$FindBin::Bin/fcm_gui", @args);
+}
+
+# Implements "fcm help" and usage.
+sub _help {
+    my ($attrib_ref, $app, $option_ref, @args) = @_;
+    $app ||= 'help';
+    my @keys = ($app eq 'help' && @args) ? @args : (q{});
+    for my $key (@keys) {
+        if (exists($FCM::CLI::Parser::PREF_NAME_OF{$key})) {
+            $key = $FCM::CLI::Parser::PREF_NAME_OF{$key};
+        }
+        my $pod
+            = $key ? catfile(dirname($INC{'FCM/CLI.pm'}), 'CLI', "fcm-$key.pod")
+            :        $0
+            ;
+        if ($pod eq $0) {
+            _version($attrib_ref, $app, $option_ref, @args);
+        }
+        my $has_pod = -f $pod;
+        if ($has_pod) {
+            my $reporter = $attrib_ref->{system}->util()->util_of_report();
+            my $verbosity = $reporter->get_ctx_of_stdout()->get_verbosity();
+            pod2usage({
+                '-exitval' => 'NOEXIT',
+                '-input'   => $pod,
+                '-verbose' => $verbosity,
+            });
+        }
+        if (!$has_pod || exists($CLI_MORE_HELP_FOR{$key})) {
+            $attrib_ref->{system}->svn('help', {}, $key ? $key : ())
+        }
+    }
+    return;
+}
+
+# "fcm test-battery".
+sub _test_battery {
+    my ($attrib_ref, $app, $option_ref, @args) = @_;
+    exec("$FindBin::Bin/fcm_test_battery", @args);
+}
+
+# Returns a function that select the alternate handler for the application. The
+# handler is either $method_id (if $opt_id is set) or "svn".
+sub _opt_func {
+    my ($opt_id, $code0_ref, $code1_ref) = @_;
+    $code0_ref = _sys_func($code0_ref);
+    $code1_ref = _sys_func($code1_ref);
+    sub {
+        my ($attrib_ref, $app, $option_ref, @args) = @_;
+        my $code_ref = exists($option_ref->{$opt_id}) ? $code0_ref : $code1_ref;
+        $code_ref->($attrib_ref, $app, $option_ref, @args);
+    };
+}
+
+# Invokes a system function.
+sub _sys_func {
+    my ($code_ref) = @_;
+    sub {
+        my ($attrib_ref, $app, @args) = @_;
+        local($S) = $attrib_ref->{system};
+        defined($code_ref) ? $code_ref->(@args) : $S->svn($app, @args);
+    };
+}
+
+# Implements "fcm version".
+sub _version {
+    my ($attrib_ref, $app, $option_ref, @args) = @_;
+    my $version = $attrib_ref->{system}->util()->version();
+    $EVENT->(FCM::Context::Event->OUT, "FCM $version\n");
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::CLI
+
+=head1 SYNOPSIS
+
+    my $cli = FCM::CLI->new();
+    $cli->(@ARGV);
+
+=head1 DESCRIPTION
+
+An implementation of the FCM command line interface.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new()
+
+Returns a new instance.
+
+=item $cli->(@ARGV)
+
+Determines the application using the first element in @ARGV, parses the options
+and arguments according to the application, and invokes the application.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=head2 FCM::CLI::Exception
+
+This exception is thrown when the CLI fails to invoke an application.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/Exception.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/Exception.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/Exception.pm	(revision 5095)
@@ -0,0 +1,57 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::CLI::Exception;
+use base qw{FCM::Exception};
+
+use constant {
+    APP => 'APP',
+    OPT => 'OPT',
+};
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::CLI::Exception
+
+=head1 SYNOPSIS
+
+    use FCM::CLI::Exception;
+    FCM::CLI::Exception->throw(FCM::CLI::Exception->APP, \@argv, $e);
+    FCM::CLI::Exception->throw(FCM::CLI::Exception->OPT, \@argv, $e);
+
+=head1 DESCRIPTION
+
+An exception associated with the FCM CLI. It is a sub-class of
+L<FCM::Exception|FCM::Exception>. The $e->get_ctx() method returns an ARRAY
+reference containing the argument list. The $e->get_code() method may return
+either $e->APP (if an unknown application is specified) or $e->OPT (if an
+unknown option is specified, i.e. the option parser returns some errors).
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/Parser.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/Parser.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/Parser.pm	(revision 5095)
@@ -0,0 +1,463 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::CLI::Parser;
+use base qw{FCM::Class::CODE};
+
+use FCM::CLI::Exception;
+use Getopt::Long qw{GetOptions :config bundling};
+
+use constant {
+    OPT_INCR => q{+},   # no argument, but incremental
+    OPT_BOOL => q{},    # no argument
+    OPT_SCAL => q{=s},  # single argument
+    OPT_LIST => q{=s@}, # multiple argument
+};
+
+# Option hash, key = preferred name of option, value = HASH reference where:
+# arg     => argument flag
+# letters => ARRAY reference of a list of option letters
+# names   => ARRAY reference of a list of names
+our %OPTION_OF = map {
+    ($_->[0][0], {arg => $_->[2], letters => $_->[1], names => $_->[0]});
+} (
+    [['archive'            ,            ], ['a'], OPT_BOOL],
+    [['auto-log'           ,            ], [   ], OPT_BOOL],
+    [['branch'             ,            ], ['b'], OPT_BOOL],
+    [['branch-of-branch'   , 'bob'      ], [   ], OPT_BOOL],
+    [['browser'            ,            ], ['b'], OPT_SCAL],
+    [['check'              ,            ], ['c'], OPT_BOOL],
+    [['clean'              ,            ], [   ], OPT_BOOL],
+    [['create'             ,            ], ['c'], OPT_BOOL],
+    [['config-file'        , 'file'     ], ['f'], OPT_LIST],
+    [['config-file-path'   ,            ], ['F'], OPT_LIST],
+    [['custom'             ,            ], [   ], OPT_BOOL],
+    [['delete'             ,            ], ['d'], OPT_BOOL],
+    [['diff-cmd'           ,            ], [   ], OPT_SCAL],
+    [['directory'          ,            ], ['C'], OPT_SCAL],
+    [['dry-run'            ,            ], [   ], OPT_BOOL],
+    [['exclude'            ,            ], [   ], OPT_LIST],
+    [['extensions'         ,            ], ['x'], OPT_SCAL],
+    [['graphical'          ,            ], ['g'], OPT_BOOL],
+    [['fcm1'               ,            ], ['1'], OPT_BOOL],
+    [['full'               ,            ], ['f'], OPT_BOOL],
+    [['help'               , 'usage'    ], ['h'], OPT_BOOL],
+    [['ignore-lock'        ,            ], [   ], OPT_BOOL],
+    [['info'               ,            ], ['i'], OPT_BOOL],
+    [['jobs'               ,            ], ['j'], OPT_SCAL],
+    [['list'               ,            ], ['l'], OPT_BOOL],
+    [['name'               ,            ], ['n'], OPT_SCAL],
+    [['new'                ,            ], ['N'], OPT_BOOL],
+    [['non-interactive'    ,            ], [   ], OPT_BOOL],
+    [['only'               ,            ], [   ], OPT_LIST],
+    [['organisation'       ,            ], [   ], OPT_SCAL],
+    [['password'           ,            ], [   ], OPT_SCAL],
+    [['quiet'              ,            ], ['q'], OPT_INCR],
+    [['relocate'           ,            ], [   ], OPT_BOOL],
+    [['reverse'            ,            ], [   ], OPT_BOOL],
+    [['revision'           ,            ], ['r'], OPT_SCAL],
+    [['rev-flag'           ,            ], [   ], OPT_SCAL],
+    [['show-all'           ,            ], ['a'], OPT_BOOL],
+    [['show-children'      ,            ], [   ], OPT_BOOL],
+    [['show-other'         ,            ], [   ], OPT_BOOL],
+    [['show-siblings'      ,            ], [   ], OPT_BOOL],
+    [['stage'              ,            ], ['s'], OPT_SCAL],
+    [['summarize'          , 'summarise'], [   ], OPT_BOOL],
+    [['svn-non-interactive',            ], [   ], OPT_BOOL],
+    [['switch'             ,            ], ['s'], OPT_BOOL],
+    [['targets'            ,            ], ['t'], OPT_LIST],
+    [['ticket'             ,            ], ['k'], OPT_LIST],
+    [['trac'               ,            ], ['t'], OPT_BOOL],
+    [['type'               ,            ], ['t'], OPT_SCAL],
+    [['url'                ,            ], [   ], OPT_BOOL],
+    [['user'               ,            ], ['u'], OPT_LIST],
+    [['verbose'            ,            ], ['v'], OPT_INCR],
+    [['verbosity'          ,            ], ['v'], OPT_SCAL],
+    [['wiki'               ,            ], ['w'], OPT_BOOL],
+    [['wiki-format'        , 'wiki'     ], ['w'], OPT_SCAL],
+    [['xml'                ,            ], [   ], OPT_BOOL],
+);
+# Hook command before parsing the options
+our %HOOK_BEFORE_FOR = (
+    'add'    => _get_code_to_match($OPTION_OF{check}),
+    'delete' => _get_code_to_match($OPTION_OF{check}),
+    'diff'   => sub {
+        _get_code_to_replace(
+            $OPTION_OF{graphical}, [qw{
+                --config-option config:working-copy:exclusive-locking-clients=
+                --diff-cmd fcm_graphic_diff
+            }]
+        )->(@_);
+        _get_code_to_replace($OPTION_OF{summarize}, ['--summarize'])->(@_);
+        _get_code_to_match($OPTION_OF{branch})->(@_);
+    },
+    'switch' => sub {!_get_code_to_match($OPTION_OF{relocate})->(@_)},
+);
+our $HELP_APP = 'help';
+# Options for known applications
+our %OPTIONS_FOR = (
+    'add'           => [$OPTION_OF{check}],
+    'branch'        => [@OPTION_OF{
+        qw{ branch-of-branch create delete info list name non-interactive
+            password quiet revision rev-flag show-all show-children
+            show-siblings svn-non-interactive ticket type user verbose
+        }
+    }],
+    'branch-create' => [@OPTION_OF{
+        qw{ branch-of-branch non-interactive password rev-flag
+            svn-non-interactive switch ticket type
+        }
+    }],
+    'branch-delete' => [@OPTION_OF{
+        qw{ non-interactive password quiet show-all show-children show-siblings
+            svn-non-interactive switch verbose
+        }
+    }],
+    'branch-diff'   => [@OPTION_OF{
+        qw{diff-cmd graphical extensions summarize trac wiki xml}
+    }],
+    'branch-info'   => [@OPTION_OF{
+        qw{quiet show-all show-children show-siblings verbose}
+    }],
+    'branch-list'   => [@OPTION_OF{
+        qw{only quiet show-all url user verbose}
+    }],
+    'browse'        => [$OPTION_OF{browser}],
+    'build'         => [@OPTION_OF{
+        qw{archive clean full ignore-lock jobs stage targets verbosity}
+    }],
+    'cfg-print'     => [$OPTION_OF{fcm1}],
+    'cmp-ext-cfg'   => [@OPTION_OF{qw{quiet verbose wiki-format}}],
+    'commit'        => [@OPTION_OF{
+        qw{dry-run password svn-non-interactive}
+    }],
+    'conflicts'     => [],
+    'delete'        => [$OPTION_OF{check}],
+    'diff'          => [@OPTION_OF{
+        qw{branch diff-cmd extensions summarize trac wiki}
+    }],
+    'export-items'  => [@OPTION_OF{qw{directory config-file new}}],
+    'extract'       => [@OPTION_OF{qw{clean full ignore-lock verbosity}}],
+    'gui'           => [],
+    $HELP_APP       => [@OPTION_OF{qw{quiet verbose}}],
+    'keyword-print' => [@OPTION_OF{qw{verbose}}],
+    'loc-layout'    => [@OPTION_OF{qw{verbose}}],
+    'make'          => [@OPTION_OF{
+        qw{ archive directory ignore-lock jobs config-file config-file-path name
+            new quiet verbose
+        }
+    }],
+    'merge'         => [@OPTION_OF{
+        qw{ auto-log custom dry-run non-interactive quiet reverse revision
+            verbose}
+    }],
+    'mkpatch'       => [@OPTION_OF{qw{exclude organisation revision}}],
+    'project-create'=> [@OPTION_OF{
+        qw{non-interactive password svn-non-interactive}
+    }],
+    'switch'        => [@OPTION_OF{qw{non-interactive revision quiet verbose}}],
+    'update'        => [@OPTION_OF{qw{non-interactive revision quiet verbose}}],
+);
+# Preferred names of known applications with aliases
+our %PREF_NAME_OF = (
+    'ann'      => 'blame',
+    'annotate' => 'blame',
+    'bcreate'  => 'branch-create',
+    'bc'       => 'branch-create',
+    'bdel'     => 'branch-delete',
+    'bdelete'  => 'branch-delete',
+    'bdi'      => 'branch-diff',
+    'bdiff'    => 'branch-diff',
+    'binfo'    => 'branch-info',
+    'bld'      => 'build',
+    'blist'    => 'branch-list',
+    'bls'      => 'branch-list',
+    'br'       => 'branch',
+    'brm'      => 'branch-delete',
+    'cfg'      => 'cfg-print',
+    'ci'       => 'commit',
+    'cf'       => 'conflicts',
+    'co'       => 'checkout',
+    'cp'       => 'copy',
+    'del'      => 'delete',
+    'di'       => 'diff',
+    'ext'      => 'extract',
+    'h'        => $HELP_APP,
+    'kp'       => 'keyword-print',
+    'ls'       => 'list',
+    'mv'       => 'move',
+    'pd'       => 'propdel',
+    'pdel'     => 'propdel',
+    'pe'       => 'propedit',
+    'pedit'    => 'propedit',
+    'pg'       => 'propget',
+    'pget'     => 'propget',
+    'pl'       => 'proplist',
+    'plist'    => 'proplist',
+    'praise'   => 'blame',
+    'ps'       => 'propset',
+    'pset'     => 'propset',
+    'ren'      => 'move',
+    'rename'   => 'move',
+    'rm'       => 'delete',
+    'remove'   => 'delete',
+    'st'       => 'status',
+    'sw'       => 'switch',
+    'stat'     => 'status',
+    'trac'     => 'browse',
+    'up'       => 'update',
+    'usage'    => $HELP_APP,
+    'www'      => 'browse',
+    '?'        => $HELP_APP,
+    '-V'       => 'version',
+    '--help'   => $HELP_APP,
+    '--usage'  => $HELP_APP,
+    '--version'=> 'version',
+);
+
+# Creates the class.
+__PACKAGE__->class(
+    {   help_app        => {isa => '$', default => $HELP_APP            },
+        help_option     => {isa => '%', default => {%{$OPTION_OF{help}}}},
+        hook_before_for => {isa => '%', default => {%HOOK_BEFORE_FOR}   },
+        options_for     => {isa => '%', default => {%OPTIONS_FOR}       },
+        pref_name_of    => {isa => '%', default => {%PREF_NAME_OF}      },
+    },
+    {action_of => {parse => \&_parse}},
+);
+
+# Parses the options and arguments.
+sub _parse {
+    my ($attrib_ref, @argv) = @_;
+    my @args = @argv;
+    my $option_hash_ref = {};
+    if (!@args) {
+        return ($attrib_ref->{help_app}, $option_hash_ref);
+    }
+    my $app = shift(@args);
+    if (exists($attrib_ref->{pref_name_of}{$app})) {
+        $app = $attrib_ref->{pref_name_of}{$app};
+    }
+    if (_get_code_to_match($attrib_ref->{help_option})->(\@args)) {
+        return ($attrib_ref->{help_app}, {}, $app);
+    }
+    if (exists($attrib_ref->{hook_before_for}{$app})) {
+        if (!$attrib_ref->{hook_before_for}{$app}->(\@args)) {
+            return ($app, $option_hash_ref, @args);
+        }
+    }
+    if (!exists($attrib_ref->{options_for}{$app})) {
+        return ($app, $option_hash_ref, @args);
+    }
+    my @option_strings = map {
+        join('|', @{$_->{names}}, @{$_->{letters}}) . $_->{arg};
+    } @{$attrib_ref->{options_for}{$app}};
+    local(@ARGV) = @args;
+    my @warnings;
+    local($SIG{__WARN__}) = sub {push(@warnings, @_)};
+    if (!GetOptions($option_hash_ref, @option_strings)) {
+        my $E = 'FCM::CLI::Exception';
+        for (@warnings) {
+            chomp();
+        }
+        return $E->throw($E->OPT, \@argv, join('|', @warnings));
+    }
+    @args = @ARGV;
+    return ($app, $option_hash_ref, @args);
+}
+
+# Returns a CODE reference for matching a simple option to a string.
+sub _get_option_matcher {
+    my ($option_ref) = @_;
+    return sub {
+        grep {$_[0] eq $_} (
+            (map {"--$_"} @{$option_ref->{names}  }),
+            (map { "-$_"} @{$option_ref->{letters}}),
+        );
+    };
+}
+
+# Returns a CODE reference for matching a simple option to a string.
+sub _get_code_to_match {
+    my ($option_ref) = @_;
+    my $grepper = _get_option_matcher($option_ref);
+    return sub {grep {$grepper->($_)} @{$_[0]}};
+}
+
+# Returns a CODE reference to replace a simple option in the argument list.
+sub _get_code_to_replace {
+    my ($option_ref, $replacement) = @_;
+    my @replacements = ref($replacement) ? @{$replacement} : $replacement;
+    my $grepper = _get_option_matcher($option_ref);
+    return sub {
+        @{$_[0]} = map {($grepper->($_) ? @replacements : $_)} @{$_[0]};
+        return 1;
+    };
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::CLI::Parser
+
+=head1 SYNOPSIS
+
+    use FCM::CLI::Parser;
+    my $cli = FCM::CLI::Parser->new(\%attrib);
+    my ($app, $opt_hash_ref, @args) = $cli->(@ARGV);
+
+=head1 DESCRIPTION
+
+This class provides an option/argument parser for the FCM command line
+interface. The parser, when called with some arguments, returns a list. The 1st
+element is the name of the application, the 2nd element is a HASH reference
+containing the option names and their values. The remaining elements are the
+remaining arguments.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Returns a new instance. The %attrib HASH may contain the following elements:
+
+=over 4
+
+=item help_app
+
+The name of the I<help> application. Default = $FCM::CLI::Parser::HELP_APP. 
+
+=item help_option
+
+An option that represents I<help>. If this option is encountered in the command
+line, the CODE reference returns (help_app, {}, $app) regardless of the other
+command line options and arguments. Default =
+$FCM::CLI::Parser::OPTIONS_FOR{help}.
+
+=item hook_before_for
+
+Hook commands for the applications, which are executed before the option parser.
+See the L</CONFIGURATIONS> section for detail. Default =
+$FCM::CLI::Parser::HOOK_BEFORE_FOR.
+
+=item options_for
+
+The options for each application. See the L</CONFIGURATIONS> section for detail.
+Default = $FCM::CLI::Parser::OPTIONS_FOR.
+
+=item pref_name_of
+
+The preferred names for the applications. See the L</CONFIGURATIONS> section for
+detail. Default = $FCM::CLI::Parser::PREF_NAME_OF.
+
+=back
+
+=item $instance->(@args)
+
+=back
+
+=head1 CONFIGURATIONS
+
+The following should only be used as read-only variables. The
+$class->new(\%attrib) method should be used to configure a parser.
+
+=over 4
+
+=item $FCM::CLI::Parser::HELP_APP
+
+The name of the I<help> application.
+
+=item %FCM::CLI::Parser::HOOK_BEFORE_FOR
+
+A hash containing the hook commands, which are invoked before calling the option
+parser. The hash keys are names of the applications, and the values are CODE
+references to invoke. If a hook exists for an application, it is called as
+$hook->(\@args) where @args is the current command line arguments (with the
+first argument, i.e. the application name removed). If the hook returns a false
+value, the parser will return immediately.
+
+=item %FCM::CLI::Parser::OPTION_OF
+
+A hash containing the known options. The key is the preferred name of the
+option, and the value is a HASH reference, where C<names> (=> ARRAY reference)
+are the long names of the option, C<letters> (=> ARRAY reference) are the
+option letters, C<arg> (=> integer) is a flag. (See L</CONSTANTS> section for
+detail.)
+
+=item %FCM::CLI::Parser::OPTIONS_FOR
+
+A hash containing the known applications. The keys are the names of the
+applications and the values are ARRAY references, each pointing to
+a list of options (as described in %FCM::CLIParser::OPTION_OF) for the
+application.
+
+=item %FCM::CLI::Parser::PREF_NAME_OF
+
+A hash containing the preferred names of an application. The keys are the
+aliases and the values are the preferred names.
+
+=back
+
+=head1 CONSTANTS
+
+=over 4
+
+=item FCM::CLI::Parser->OPT_BOOL
+
+Option flag. Option is a boolean with no argument.
+
+=item FCM::CLI::Parser->OPT_INCR
+
+Option flag. Option has no argument but is incremental.
+
+=item FCM::CLI::Parser->OPT_LIST
+
+Option flag. Option has one or more arguments.
+
+=item FCM::CLI::Parser->OPT_SCAL
+
+Option flag. Option has a single argument.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item FCM::CLI::Parser::Exception
+
+This exception is raised if an invalid command option is given. It inherits from
+L<FCM::Exception>. There is no error code associated with this exception. The
+$e->get_ctx() method returns an ARRAY reference containing the original
+arguments.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-add.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-add.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-add.pod	(revision 5095)
@@ -0,0 +1,22 @@
+=head1 NAME
+
+fcm add
+
+=head1 SYNOPSIS
+
+    1. fcm add --check [PATH ...]
+
+=head1 OPTIONS
+
+=over 4
+
+=item --check, -c
+
+Check for any files or directories reported by "L<svn|svn> status" as not under
+version control and add them.
+
+=back
+
+For other options, see output of "L<svn|svn> help add".
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-create.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-create.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-create.pod	(revision 5095)
@@ -0,0 +1,86 @@
+=head1 NAME
+
+fcm branch-create (bcreate, bc)
+
+=head1 SYNOPSIS
+
+Creates a branch.
+
+    fcm branch-create [OPTIONS] NAME [SOURCE]
+
+=head1 ARGUMENTS
+
+NAME is a short name for the branch, which should contain only characters in the
+set [A-Za-z0-9_\-\.]. If the --ticket=N option is not specified and NAME
+contains only a list of positive integers separated by [_-] (an underscore or a
+hyphen), the command will assume that NAME also specifies the related ticket
+numbers.
+
+SOURCE can be an URL or a Subversion working copy. Otherwise, the current
+working directory must be a working copy. The specified URL (or the URL of the
+working copy) must be URL under a standard FCM project.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --branch-of-branch, --bob
+
+If this option is specified and the SOURCE is a branch, it will create a new
+branch from the SOURCE branch. Otherwise, the branch is created from the trunk.
+
+=item --non-interactive
+
+Do no interactive prompting. This option implies --svn-non-interactive.
+
+=item --password=PASSWORD
+
+Specify a password for write access to the repository.
+
+=item --rev-flag=NONE|NORMAL|NUMBER
+
+Specify a flag for determining the prefix of the branch name. The flag can be
+the string "NORMAL", "NUMBER" or "NONE".  "NORMAL" is the default behaviour,
+in which the branch name will be prefixed with a Subversion revision number if
+the revision is not associated with a registered FCM revision keyword. If the
+revision is registered with a FCM revision keyword, the keyword will be used in
+place of the number. If "NUMBER" is specified, the branch name will always be
+prefixed with a Subversion revision number. If "NONE" is specified, the branch
+name will not be prefixed by a revision number or keyword.
+
+=item --svn-non-interactive
+
+Do no interactive prompting at commit time. This option is implied by
+--non-interactive.
+
+=item --switch
+
+C<fcm switch> the current working directory (if it contains a relevant working
+copy) to point to the newly created branch after the branch is created.
+
+=item --ticket=N, -k N
+
+Specify one (or more) Trac ticket. If specified, the ticket numbers will be
+included in the commit log message. Multiple tickets can be set by specifying
+this option multiple times, or by specifying the tickets in a comma-separated
+list.
+
+=item --type=TYPE, -t TYPE
+
+Specify the type of the branch to be created. It must be one of the following:
+
+ DEV::USER [DEV, USER] - a development branch for the user
+ DEV::SHARE [SHARE]    - a shared development branch
+ TEST::USER [TEST]     - a test branch for the user
+ TEST::SHARE           - a shared test branch
+ PKG::USER [PKG]       - a package branch for the user
+ PKG::SHARE            - a shared package branch
+ PKG::CONFIG [CONFIG]  - a configuration branch
+ PKG::REL [REL]        - a release branch
+
+If not specified, the default is to create a development branch for the current
+user, i.e.  DEV::USER.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-delete.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-delete.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-delete.pod	(revision 5095)
@@ -0,0 +1,61 @@
+=head1 NAME
+
+fcm branch-delete (bdelete bdel brm)
+
+=head1 SYNOPSIS
+
+Deletes a branch.
+
+    fcm branch-delete [OPTIONS] [TARGET]
+
+=head1 ARGUMENTS
+
+TARGET can be an URL or a Subversion working copy. Otherwise, the current
+working directory must be a working copy. The specified URL (or the URL of the
+working copy) must be a URL under a valid branch in a standard FCM project.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --verbose, -v
+
+Print extra information.
+
+=item --show-all, -a
+
+Set --show-children, --show-other and --show-siblings.
+
+=item --show-children
+
+Report children of the current branch.
+
+=item --show-other
+
+Report custom/ reverse merges into the current branch.
+
+=item --show-siblings
+
+Report merges with siblings of the current branch.
+
+=item --non-interactive
+
+Do no interactive prompting. This option implies --svn-non-interactive.
+
+=item --password=PASSWORD
+
+Specify a password for write access to the repository.
+
+=item --svn-non-interactive
+
+Do no interactive prompting at commit time. This option is implied by
+--non-interactive.
+
+=item --switch
+
+If TARGET not specified in the argument list, C<fcm switch> the current working
+copy to point to the C<trunk> after the branch deletion.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-diff.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-diff.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-diff.pod	(revision 5095)
@@ -0,0 +1,52 @@
+=head1 NAME
+
+fcm branch-diff (bdiff, bdi)
+
+=head1 SYNOPSIS
+
+Show differences relative to the base of the target branch, i.e. the changes
+available for merging from the target branch into its parent.
+
+    fcm branch-diff [OPTIONS] [TARGET]
+
+=head1 ARGUMENTS
+
+If TARGET is specified, it must either be a URL or a working copy. Otherwise,
+the target is the current directory which must be a working copy. The target
+URL must be a branch in a standard FCM project.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --diff-cmd=PATH
+
+Use PATH as I<diff> command.
+
+=item --graphical, -g
+
+Equivalent to C<--diff-cmd=fcm_graphic_diff>.
+
+=item --summarize, --summarise
+
+Show a summary of the results.
+
+=item --xml
+
+With --summarise, show a summary of the results in XML format.
+
+=item --trac, -t
+
+If TARGET is a URL, use Trac to display the diff.
+
+=item --wiki
+
+If TARGET is a URL, print Trac link for the diff.
+
+=item --extensions=ARG, -x ARG
+
+Options of the I<diff> command. See the help for "L<svn|svn> diff".
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-info.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-info.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-info.pod	(revision 5095)
@@ -0,0 +1,43 @@
+=head1 NAME
+
+fcm branch-info (binfo)
+
+=head1 SYNOPSIS
+
+Displays information of a branch.
+
+    fcm branch-info [OPTIONS] [TARGET]
+
+=head1 ARGUMENTS
+
+TARGET can be an URL or a Subversion working copy. Otherwise, the current
+working directory must be a working copy. The specified URL (or the URL of the
+working copy) must be a URL under a valid branch in a standard FCM project.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --verbose, -v
+
+Print extra information.
+
+=item --show-all, -a
+
+Set --show-children, --show-other and --show-siblings.
+
+=item --show-children
+
+Report children of the current branch.
+
+=item --show-other
+
+Report custom/ reverse merges into the current branch.
+
+=item --show-siblings
+
+Report merges with siblings of the current branch.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-list.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-list.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch-list.pod	(revision 5095)
@@ -0,0 +1,52 @@
+=head1 NAME
+
+fcm branch-list (blist, bls)
+
+=head1 SYNOPSIS
+
+Searches and lists branches in projects. By default, it lists only branches
+created by the current user.
+
+    fcm branch-list [OPTIONS] [TARGET ...]
+
+=head1 ARGUMENTS
+
+If no TARGET is specified, the current working directory is assumed to be the
+target. Each target must either be a URL[@REV] or a PATH[@REV] to a working copy
+of a standard FCM project.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --only=DEPTH:PATTERN, ...
+
+Specify a regular expression to match at various depth. E.g.  with the normal
+FCM branch naming convention, C<--only=1:dev --only=2:fred> will display only
+the development branches owned by user ID "fred". (This option is cumalative,
+and overrides the --show-all and --user=PATTERN options.)
+
+=item --quiet, -q
+
+Decreases verbosity. Only prints branches matching the search criteria.
+
+=item --show-all, -a
+
+Print branches of all users. (This option overrides the --user=USER option.)
+
+=item --url
+
+Displays Subversion URL instead of FCM location keywords.
+
+=item --user=PATTERN, -u PATTERN
+
+Equivalent to --only=2:^PATTERN$ for projects with the normal FCM branch naming
+convention. Lists branches created by the specified list of users instead of the
+current user. With the normal FCM branch naming convention, you can also list
+shared branches by specifying the user as "Share", configuration branches by
+specifying the user as "Config" and release branches by specifying the user as
+"Rel". (This option is cumalative.)
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-branch.pod	(revision 5095)
@@ -0,0 +1,37 @@
+=head1 NAME
+
+fcm branch (br)
+
+=head1 SYNOPSIS
+
+    1. fcm branch --create --name NAME [OPTIONS] [SOURCE]
+       fcm branch -c           -n NAME [OPTIONS] [SOURCE]
+    2. fcm branch --delete             [OPTIONS] [TARGET]
+       fcm branch -d                   [OPTIONS] [TARGET]
+    3. fcm branch --info               [OPTIONS] [TARGET]
+       fcm branch                      [OPTIONS] [TARGET]
+    4. fcm branch --list               [OPTIONS] [TARGET]
+       fcm branch -l                   [OPTIONS] [TARGET]
+
+This command is deprecated. The 4 usages are replaced by:
+
+=over 4
+
+=item 1.
+
+C<fcm branch-create>: Type C<fcm help branch-create> for detail.
+
+=item 2.
+
+C<fcm branch-delete>: Type C<fcm help branch-delete> for detail.
+
+=item 3.
+
+C<fcm branch-info>: Type C<fcm help branch-info> for detail.
+
+=item 4.
+
+C<fcm branch-list>: Type C<fcm help branch-list> for detail.
+
+=back
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-browse.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-browse.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-browse.pod	(revision 5095)
@@ -0,0 +1,30 @@
+=head1 NAME
+
+fcm browse (trac www)
+
+=head1 SYNOPSIS
+
+Invokes the browser for a version controlled target.
+
+    fcm browse [OPTIONS] [TARGET ...]
+
+=head1 ARGUMENTS
+
+If TARGET is specified, it must be a FCM URL keyword, a Subversion URL or the
+path to a local working copy. If not specified, the current working directory
+is assumed to be a working copy. If the --browser option is specified, the
+specified web browser command is used to launch the repository browser.
+Otherwise, it attempts to use the default browser from the configuration
+setting.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --browser=COMMAND
+
+Specify the web browser command.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-build.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-build.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-build.pod	(revision 5095)
@@ -0,0 +1,91 @@
+=head1 NAME
+
+fcm build (bld)
+
+=head1 SYNOPSIS
+
+Invokes the deprecated FCM 1 build system.
+
+    fcm build [OPTIONS] [CFGFILE]
+
+=head1 ARGUMENTS
+
+The path to a CFGFILE may be provided. Otherwise, the build system searches the
+default locations for a bld cfg file.
+
+=head1 OPTIONS
+
+If no option is specified, the options "-s 5 -t all -j 1 -v 1" are assumed.
+
+=over 4
+
+=item --archive, -a
+
+Archive sub-directories on success. If archive mode is switched on, build
+sub-directories that are only used in the build process will be archived to
+TAR-GZIP files.
+
+=item --clean
+
+Clean the destination.
+
+=item --full, -f
+
+Run in full mode. If the option for full build is specified, the
+sub-directories created by previous builds will be removed, so that the current
+build can start cleanly.
+
+=item --ignore-lock
+
+Ignore lock file. When a build is invoked, it sets up a lock file in the build
+root directory.  The lock is normally removed at the end of the build. While the
+lock file is in place, the build commands invoked in the same root directory
+will fail. If you need to bypass this check for whatever reason, you can invoke
+the build system with this option.
+
+=item --jobs=N, -j N
+
+Specify the number of parallel jobs.
+
+=item --stage=N, -s N
+
+Run command up to a named stage. The stages are:
+
+=over 4
+
+=item "1", "s" or "setup"
+
+Stage 1, setup.
+
+=item "2", "pp" or "pre_process"
+
+Stage 2, pre-process.
+
+=item "3", "gd" or "generate_dependency"
+
+Stage 3, generate dependency.
+
+=item "4", "gi" or "generate_interface"
+
+Stage 4, generate Fortran 9X interface.
+
+=item "5", "m", "make"
+
+Stage 5, make.
+
+=back
+
+=item --targets=TARGETS, -t TARGETS
+
+List of build targets, delimited by (:). If specified, the default targets
+declared in the configuration file will not be used.
+
+=item --verbose=N, -v N
+
+Specify the verbosity level. If specified, the verbosity level must be an
+integer greater than 0. Verbosity level 0 is the quiet mode. Increasing the
+verbosity level will increase the amount of diagnostic output.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-cfg-print.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-cfg-print.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-cfg-print.pod	(revision 5095)
@@ -0,0 +1,23 @@
+=head1 NAME
+
+fcm cfg-print (cfg)
+
+=head1 SYNOPSIS
+
+Parses each FCM configuration file specified in the argument list, and prints
+the result to STDOUT.
+
+    fcm cfg-print [OPTIONS] [TARGET ...]
+
+=head1 OPTIONS
+
+=over 4
+
+=item --fcm1, -1
+
+If specified, targets should be in FCM 1 format. Otherwise, they should be in
+FCM 2 format.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-changelist.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-changelist.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-changelist.pod	(revision 5095)
@@ -0,0 +1,9 @@
+=head1 NAME
+
+fcm changelist
+
+=head1 SYNOPSIS
+
+    svn changelist is not supported under fcm.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-cmp-ext-cfg.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-cmp-ext-cfg.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-cmp-ext-cfg.pod	(revision 5095)
@@ -0,0 +1,30 @@
+=head1 NAME
+
+fcm cmp-ext-cfg
+
+=head1 SYNOPSIS
+
+Compares the extract configurations of two similar FCM 1 extract configuration
+files CFGFILE1 and CFGFILE2. This application is deprecated.
+
+    fcm cmp-ext-cfg [OPTIONS] CFFILE1 CFGFILE2
+
+=head1 OPTIONS
+
+=over 4
+
+=item --verbose=N, -v N
+
+Specify the verbosity level. In normal mode with verbosity level 2 or above,
+displays the change log of each revision.
+
+=item --wiki-format=TARGET
+
+Print revision tables in wiki format. In wiki mode, print revision tables in
+wiki format. The argument to this option must be the Subversion URL or FCM URL
+keyword of a FCM project associated with the intended Trac system. The --verbose
+option has no effect in wiki mode.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-commit.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-commit.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-commit.pod	(revision 5095)
@@ -0,0 +1,31 @@
+=head1 NAME
+
+fcm commit (ci)
+
+=head1 SYNOPSIS
+
+Send changes from your working copy to the repository. Invoke your favourite
+editor to prompt you for a commit log message. Update your working copy
+following the commit.
+
+    fcm commit [OPTIONS] [PATH ...]
+
+=head1 OPTIONS
+
+=over 4
+
+=item --dry-run
+
+Allows you to add to the commit message without committing.
+
+=item --svn-non-interactive
+
+Do no interactive prompting at commit time.
+
+=item --password=PASSWORD
+
+Specify a password ARG.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-conflicts.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-conflicts.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-conflicts.pod	(revision 5095)
@@ -0,0 +1,17 @@
+=head1 NAME
+
+fcm conflicts (cf)
+
+=head1 SYNOPSIS
+
+Use graphical tool to resolve any conflicts within your working copy.
+
+    fcm conflicts [PATH]
+
+=head1 ARGUMENTS
+
+Invoke a graphical merge tool to help you resolve conflicts in your working copy
+at PATH. It prompts you to run "L<svn|svn> resolved" each time you have resolved
+the conflicts in a text file.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-delete.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-delete.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-delete.pod	(revision 5095)
@@ -0,0 +1,22 @@
+=head1 NAME
+
+fcm delete (del, remove, rm)
+
+=head1 SYNOPSIS
+
+    fcm delete [OPTIONS] [TARGETS]
+
+=head1 OPTIONS
+
+=over 4
+
+=item --check, -c
+
+Check for any files or directories reported by "L<svn|svn> status" as missing
+and schedule them for removal.
+
+=back
+
+For other options, see output of "L<svn|svn> help delete".
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-diff.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-diff.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-diff.pod	(revision 5095)
@@ -0,0 +1,45 @@
+=head1 NAME
+
+fcm diff (di)
+
+=head1 SYNOPSIS
+
+Display the differences between two revisions or paths.
+
+    1. fcm diff --branch [OPTIONS] [TARGET]
+       fcm diff -b                 [TARGET]
+    2. fcm diff [OPTIONS] [ARGS]
+
+=over 4
+
+=item 1.
+
+This usage is deprecated. It is replaced by C<fcm branch-diff>. Type
+C<fcm help branch-diff> for detail.
+
+=item 2.
+
+See the output of "L<svn|svn> help diff".
+
+=back
+
+=head1 OPTIONS
+
+The following are additional options supported by C<fcm diff>.
+
+=over 4
+
+=item --graphical, -g
+
+If this option is specified, the command uses a graphical tool to display the
+differences. This option can be used in combination with all other valid
+options except --diff-cmd and --extensions.
+
+=item --summarise
+
+This option is implemented in FCM as a wrapper to the Subversion --summarize
+option. It prints only a summary of the results.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-export-items.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-export-items.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-export-items.pod	(revision 5095)
@@ -0,0 +1,57 @@
+=head1 NAME
+
+fcm export-items
+
+=head1 SYNOPSIS
+
+Exports directories in SOURCE as a list of versioned items.
+
+This command is used to support a legacy working practice, in which directories
+in a source tree are regarded as individual versioned items.
+
+    fcm export-items [OPTIONS] SOURCE
+
+=head1 ARGUMENTS
+
+The SOURCE should be the URL of a branch in a Subversion repository with the
+standard FCM layout.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --config-file=PATH, --file=PATH, -f PATH
+
+Specify the path to the configuration file.
+(default=$PWD/fcm-export-items.cfg)
+
+=item --directory=PATH, -C PATH
+
+Specify the path to the destination. (default=$PWD)
+
+=item --new, -N
+
+Specify the new mode. In this mode, everything is re-exported. Otherwise, the
+system runs in incremental mode, in which the version directories are only
+updated if they do not already exist.
+
+=back
+
+=head1 CONFIGURATION
+
+The configuration file should be in the deprecated FCM 1 configuration format.
+The label in each entry should be a path relative to the source URL. If the path
+ends in * then the path is expanded recursively and any sub-directories
+containing regular files are added to the list of relative paths to export. The
+value may be empty, or it may be a list of space separated "conditions". Each
+condition is a conditional operator (>, >=, <, <=, == or !=) followed by a
+revision number. The command uses the revision log to determine the revisions at
+which the relative path has been updated in the source URL. If these revisions
+also satisfy the "conditions" set by the user, they will be considered in the
+export.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-extract.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-extract.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-extract.pod	(revision 5095)
@@ -0,0 +1,46 @@
+=head1 NAME
+
+fcm extract (ext)
+
+=head1 SYNOPSIS
+
+Invokes the deprecated FCM 1 extract system.
+
+    fcm extract [OPTIONS] [CFGFILE]
+
+=head1 ARGUMENTS
+
+The path to a CFG file may be provided. Otherwise, the extract system searches
+the default locations for an ext cfg file.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --clean
+
+Clean the destination.
+
+=item --full, -f
+
+Run in full mode. If the option for full extract is specified, the
+sub-directories created by previous extracts will be removed, so that the
+current extract can start cleanly.
+
+=item --ignore-lock
+
+Ignore lock file. When an extract is invoked, it sets up a lock file in the
+extract root directory.  The lock is normally removed at the end of the extract.
+While the lock file is in place, the extract commands invoked in the same root
+directory will fail. If you need to bypass this check for whatever reason, you
+can invoke the extract system with this option.
+
+=item --verbose=N, -v N
+
+Specify the verbosity level. If specified, the verbosity level must be an
+integer greater than 0. Verbosity level 0 is the quiet mode. Increasing the
+verbosity level will increase the amount of diagnostic output.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-gui.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-gui.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-gui.pod	(revision 5095)
@@ -0,0 +1,12 @@
+=head1 NAME
+
+fcm gui
+
+=head1 SYNOPSIS
+
+Invokes the GUI wrapper for code management commands. The optional argument PATH
+modifies the initial working directory of the GUI.
+
+    fcm gui [PATH]
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-help.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-help.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-help.pod	(revision 5095)
@@ -0,0 +1,25 @@
+=head1 NAME
+
+fcm help (h, usage, --help, --usage)
+
+=head1 SYNOPSIS
+
+Describes the usage of this program or its subcommands.
+
+    fcm help [OPTIONS] [SUBCOMMAND...]
+
+=head1 OPTIONS
+
+=over 4
+
+=item --quiet, -q
+
+Decrease the verbosity level.
+
+=item --verbose, -v
+
+Increase the verbosity level.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-keyword-print.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-keyword-print.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-keyword-print.pod	(revision 5095)
@@ -0,0 +1,27 @@
+=head1 NAME
+
+fcm keyword-print (kp)
+
+=head1 SYNOPSIS
+
+Displays registered location and/or revision keywords.
+
+    fcm keyword-print [OPTIONS] [TARGET ...]
+
+=head1 ARGUMENTS
+
+If no argument is specified, prints registered location keywords. Otherwise,
+prints the location keyword and revision keywords for the specified target. If
+--verbose is specified, prints the implied location keywords as well.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --verbose, -v
+
+Increase the verbosity level.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-loc-layout.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-loc-layout.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-loc-layout.pod	(revision 5095)
@@ -0,0 +1,25 @@
+=head1 NAME
+
+fcm loc-layout
+
+=head1 SYNOPSIS
+
+Parse the URL of a FCM/Subversion TARGET, and print its FCM layout information.
+
+    fcm keyword-print [OPTIONS] [TARGET ...]
+
+=head1 ARGUMENTS
+
+If no argument is specified, TARGET is the current working directory.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --verbose, -v
+
+Increase the verbosity level.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-make.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-make.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-make.pod	(revision 5095)
@@ -0,0 +1,75 @@
+=head1 NAME
+
+fcm make
+
+=head1 SYNOPSIS
+
+Invokes the FCM make system. See the user guide for detail.
+
+    fcm make [OPTIONS] [DECLARATION ...]
+
+=head1 ARGUMENTS
+
+Each argument is considered to be a declaration line to append to the
+configuration file.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --archive, -a
+
+Switch on archive mode. In archive mode, intermediate files will be put into
+TAR-GZIP archives on completion, e.g. extract system:
+C<.fcm-make/cache/extract/>, and build system: C<build/include/> and
+C<build/o/>.
+
+The archive mode is not suitable for a make that will be inherited or used by
+other makes.
+
+=item --config-file-path=PATH, -F PATH
+
+Specify paths for searching configuration files specified in relative paths.
+
+=item --config-file=PATH, --file=PATH, -f PATH
+
+Specify paths to the configuration files. (default = fcm-make.cfg in the
+current working directory)
+
+=item --directory=PATH, -C PATH
+
+Change directory to C<PATH> before doing anything. (default = $PWD)
+
+=item --ignore-lock
+
+Ignore lock file. When the system is invoked, it sets up a lock file in the
+destination.  The lock is normally removed when the system completes the make.
+While the lock file is in place, another make invoked in the same destination
+will fail. This option can be used to bypass this check.
+
+=item --jobs=N, -j N
+
+Specify the number of (child) processes that can be run simultaneously.
+
+=item --name=NAME, -n NAME
+
+Specify a name for the make, so that the command will search for
+fcm-makeC<NAME>.cfg instead of fcm-make.cfg, and will write context files in
+.fcm-makeC<NAME>/ and log files as fcm-makeC<NAME>.log, etc.
+
+=item --new, -N
+
+Remove items in the destination created by the previous make, and starts a new
+make.
+
+=item --quiet, -q
+
+Decrease the verbosity level.
+
+=item --verbose, -v
+
+Increase the verbosity level.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-merge.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-merge.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-merge.pod	(revision 5095)
@@ -0,0 +1,78 @@
+=head1 NAME
+
+fcm merge
+
+=head1 SYNOPSIS
+
+Merge changes from a source into your working copy.
+
+    1. fcm merge SOURCE
+    2. fcm merge --custom  --revision N[:M] SOURCE
+       fcm merge --custom  URL[\@REV1] URL[\@REV2]
+    3. fcm merge --reverse --revision [M:]N
+
+=over 4
+
+=item 1.
+
+If neither --custom nor --reverse is specified, the command merges changes
+automatically from SOURCE into your working copy. SOURCE must be a valid
+URL[@REV] of a branch in a standard FCM project. The base of the merge will be
+calculated automatically based on the common ancestor and latest merge
+information between the SOURCE and the branch of the working copy.
+
+=item 2.
+
+If --custom is specified, the command can be used in two forms.
+  
+In the first form, it performs a custom merge from the specified changeset(s) of
+SOURCE into your working copy. SOURCE must be a valid URL[@REV] of a branch in
+a standard FCM project. If a single revision is specified, the merge delta is (N
+- 1):N of SOURCE. Otherwise, the merge delta, is N:M of SOURCE, where N < M.
+     
+In the second form, it performs a custom merge using the delta between the two
+specified branch URLs. For each URL, if a peg revision is not specified, the
+command will peg the URL with its last changed revision.
+
+=item 3.
+
+If --reverse is specified, the command performs a reverse merge of the
+changeset(s) specified by the --revision=M:N option. If a revision is not
+specified with --rev=M:N, it attempts to merge the delta COMMITTED:(COMMITTED -
+1). If a single revision N is specified, the merge delta is N:(N - 1).
+Otherwise, the merge delta is M:N, where M > N. Note that you do not have to
+specify a SOURCE for a reverse merge, because the SOURCE should always be the
+branch your working copy is pointing to.
+  
+=back
+
+The command provide a commit log message template following the merge.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --auto-log
+
+In automatic mode, adds the log messages of the merged revisions in the commit
+log. Has no effect in other merge modes.
+
+=item --dry-run
+
+Try operation but make no changes.
+
+=item --non-interactive
+
+Do no interactive prompting.
+
+=item --revision=REV, -r REV
+
+Specify a (range of) revision number(s).
+
+=item --verbose, -v
+
+Print extra information.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-mkpatch.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-mkpatch.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-mkpatch.pod	(revision 5095)
@@ -0,0 +1,61 @@
+=head1 NAME
+
+fcm mkpatch
+
+=head1 SYNOPSIS
+
+Create patches from specified revisions of a URL
+
+    fcm mkpatch [OPTIONS] URL [OUTDIR]
+
+=head1 ARGUMENTS
+
+If OUTDIR is specified, the output is sent to OUTDIR. Otherwise, the output will
+be sent to a default location in the current directory ($PWD/fcm-mkpatch-out).
+The output directory will contain the patch for each revision as well as a
+script for importing the patch.
+
+A warning is given if the URL is not of a branch in a FCM project or if it is a
+sub-directory of a branch.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --exclude arg
+
+Exclude a path in the URL. Multiple paths can be specified by using a
+colon-separated list of paths, or by specifying this option multiple times.
+
+The specified path must be a relative path of the URL. Glob patterns such as *
+and ? are acceptable. Changes in an excluded path will not be considered in the
+patch. A changeset containing changes only in the excluded path will not be
+considered at all.
+
+=item --organisation arg
+
+This option can be used to specify the name of your organisation.
+
+The command will attempt to parse the commit log message for each revision in
+the patch. It will remove all merge templates, replace Trac links with a
+modified string, and add information about the original changeset. If you
+specify the name of your organisation, it will replace Trac links such as
+"ticket:123" with "$organisation_ticket:123", and report the original changeset
+with a message such as "$organisation_changeset:1000".  If the organisation
+name is not specified then it defaults to "original".
+
+=item --revision=arg, -r arg
+
+Specify a revision number or a revision number range.
+
+If a revision is specified with the --revision option, it will attempt to create
+a patch based on the changes at that revision. If a revision is not specified,
+it will attempt to create a patch based on the changes at the HEAD revision. If
+a revision range is specified, it will attempt to create a patch for each
+revision in that range (including the change in the lower range) where changes
+have taken place in the URL. No output will be written if there is no change in
+the given revision (range).
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-project-create.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-project-create.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-project-create.pod	(revision 5095)
@@ -0,0 +1,34 @@
+=head1 NAME
+
+fcm project-create
+
+=head1 SYNOPSIS
+
+Creates a new project in a repository.
+
+    fcm project-create [OPTIONS] PROJECT-NAME REPOS-ROOT-URL
+
+=head1 ARGUMENTS
+
+PROJECT-NAME is a valid name of a project for the given repository.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --non-interactive
+
+Do no interactive prompting. This option implies --svn-non-interactive.
+
+=item --password=PASSWORD
+
+Specify a password for write access to the repository.
+
+=item --svn-non-interactive
+
+Do no interactive prompting at commit time. This option is implied by
+--non-interactive.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-switch.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-switch.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-switch.pod	(revision 5095)
@@ -0,0 +1,16 @@
+=head1 NAME
+
+fcm switch (sw)
+
+=head1 SYNOPSIS
+
+Update the working copy to a different URL.
+
+    1. fcm switch URL[@REV1] [PATH]
+    2. fcm switch --relocate FROM TO [PATH...]
+
+Note: if --relocate is not specified, "fcm switch" will only support the options
+--non-interactive, --revision (-r) and --quiet (-q). For detail, see the output
+of "L<svn|svn> help switch".
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-test-battery.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-test-battery.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-test-battery.pod	(revision 5095)
@@ -0,0 +1,56 @@
+=head1 NAME
+
+fcm test-battery
+
+=head1 SYNOPSIS
+
+Run FCM self tests.
+
+    fcm test-battery [...]
+
+=head1 ARGUMENTS
+
+Change directory to the FCM source tree, and runs this shell commmand:
+
+    exec prove -j "${NPROC:-9}" -s -r "${@:-t}"
+
+where NPROC is the number of processors on your computer. You can override the
+L<prove|prove> command line by specifying extra arguments. E.g. If you do not
+want to run the full test suite, you can specify the names of individual test
+files or their containing directories as extra arguments. For example:
+
+Run the full test suite with the default options.
+
+    fcm test-battery
+
+Run the full test suite with 12 processes.
+
+    fcm test-battery -j 12
+
+Run only tests under C<t/fcm-make/> with 12 processes.
+
+    fcm test-battery -j 12 t/fcm-make
+
+Run only C<t/fcm-make/10-log.t> in verbose mode.
+
+    fcm test-battery -v t/fcm-make/10-log.t
+
+=head1 OPTIONS
+
+Environment variables:
+
+=over 4
+
+=item TEST_PROJECT
+
+If this is set, run CM tests using a project sub-hierarchy in the test
+repositories.
+
+=item TEST_REMOTE_HOST
+
+If this is set, run CM tests using an auto-generated Subversion server on the
+host specified.
+
+=back
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-update.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-update.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-update.pod	(revision 5095)
@@ -0,0 +1,14 @@
+=head1 NAME
+
+fcm update (up)
+
+=head1 SYNOPSIS
+
+Bring changes from the repository into the working copy.
+
+    fcm update [PATH...]
+
+Note: "fcm update" only supports --non-interactive, --revision=REV (-r REV) and
+--quiet (-q). For detail, see the output of "L<svn|svn> help update".
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-version.pod
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-version.pod	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/CLI/fcm-version.pod	(revision 5095)
@@ -0,0 +1,11 @@
+=head1 NAME
+
+fcm version (--version, -V)
+
+=head1 SYNOPSIS
+
+Print FCM version.
+
+    fcm version
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Class/CODE.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Class/CODE.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Class/CODE.pm	(revision 5095)
@@ -0,0 +1,307 @@
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+#-------------------------------------------------------------------------------
+package FCM::Class::CODE;
+use FCM::Class::Exception;
+use Scalar::Util qw{reftype};
+
+# Methods for working out the default value of an attribute.
+my %ATTRIB_DEFAULT_BY = (
+    default => sub {
+        my $opt_ref = shift();
+        my $ret = $opt_ref->{default};
+        return (ref($ret) && reftype($ret) eq 'CODE' ? $ret->() : $ret);
+    },
+    isa     => sub {
+        my $opt_ref = shift();
+        return
+              $opt_ref->{isa} eq 'ARRAY' ? []
+            : $opt_ref->{isa} eq 'HASH'  ? {}
+            : $opt_ref->{isa} eq 'CODE'  ? sub {}
+            :                              undef
+            ;
+    },
+);
+
+# Checks the value of an attribute.
+my $ATTRIB_CHECK = sub {
+    my ($class, $opt_ref, $key, $value, $caller_ref) = @_;
+    # Note: undef is always OK?
+    if (!defined($value)) {
+        return;
+    }
+    my $expected_isa = $opt_ref->{isa};
+    if (!$expected_isa || $expected_isa eq 'SCALAR' && !ref($value)) {
+        return;
+    }
+    if (!UNIVERSAL::isa($value, $expected_isa)) {
+        return FCM::Class::Exception->throw({
+            'code'    => FCM::Class::Exception->CODE_TYPE,
+            'caller'  => $caller_ref,
+            'package' => $class,
+            'key'     => $key,
+            'type'    => $expected_isa,
+            'value'   => $value,
+        });
+    }
+};
+
+# Creates the methods of the class.
+sub class {
+    my ($class, $attrib_opt_ref, $class_opt_ref) = @_;
+    my %class_opt = (
+        init        => sub {},
+        init_attrib => sub {@_},
+        action_of   => {},
+        (defined($class_opt_ref) ? %{$class_opt_ref} : ()),
+    );
+    if (!defined($attrib_opt_ref)) {
+        $attrib_opt_ref = {};
+    }
+    my %attrib_opt;
+    while (my ($key, $item) = each(%{$attrib_opt_ref})) {
+        my %option = (
+            r       => 1,     # readable?
+            w       => 1,     # writable?
+            default => undef, # default value or CODE to return it
+            isa     => undef, # attribute isa 
+            (     defined($item) && ref($item) ? %{$item}
+                : defined($item)               ? (isa => $item)
+                :                                ()
+            ),
+        );
+        if (defined($option{isa})) {
+            $option{isa}
+                = $option{isa} eq '$' ? 'SCALAR'
+                : $option{isa} eq '@' ? 'ARRAY'
+                : $option{isa} eq '%' ? 'HASH'
+                : $option{isa} eq '&' ? 'CODE'
+                : $option{isa} eq '*' ? 'GLOB'
+                :                       $option{isa}
+                ;
+        }
+        $attrib_opt{$key} = \%option;
+    }
+    my $main_ref = sub {
+        my ($attrib_ref, $key, @args) = @_;
+        if (!exists($class_opt{action_of}{$key})) {
+            return;
+        }
+        $class_opt{action_of}{$key}->($attrib_ref, @args);
+    };
+    no strict qw{refs};
+    # $class->new(\%attrib)
+    *{$class . '::new'} = sub {
+        my $class = shift();
+        my ($attrib_ref) = $class_opt{init_attrib}->(@_);
+        my $caller_ref = [caller()];
+        my %attrib = (defined($attrib_ref) ? %{$attrib_ref} : ());
+        while (my ($key, $value) = each(%attrib)) {
+            if (exists($attrib_opt{$key})) {
+                $ATTRIB_CHECK->(
+                    $class, $attrib_opt{$key}, $key, $value, $caller_ref,
+                );
+            }
+            #else {
+            #    delete($attrib{$key});
+            #}
+        }
+        my $self = bless(sub {$main_ref->(\%attrib, @_)}, $class);
+        KEY:
+        while (my ($key, $opt_ref) = each(%attrib_opt)) {
+            if (exists($attrib{$key})) {
+                next KEY;
+            }
+            for my $opt_name (qw{default isa}) {
+                if (defined($opt_ref->{$opt_name})) {
+                    $attrib{$key} = $ATTRIB_DEFAULT_BY{$opt_name}->($opt_ref);
+                    next KEY;
+                }
+            }
+        }
+        $class_opt{init}->(\%attrib, $self);
+        return $self;
+    };
+    # $instance->$key()
+    for my $key (keys(%{$class_opt{action_of}})) {
+        *{$class . '::' . $key}
+            = sub {my $self = shift(); $self->($key, @_)};
+    }
+    return 1;
+}
+
+#-------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Class::CODE
+
+=head1 SYNOPSIS
+
+    # Example
+    package Bar;
+    use base qw{FCM::Class::CODE};
+    __PACKAGE__->class(
+        {
+            # ...
+        },
+        {
+            action_of => {
+                bend => sub {
+                    my ($attrib_ref, @args) = @_;
+                    # ...
+                },
+                stretch => sub {
+                    my ($attrib_ref, @args) = @_;
+                    # ...
+                },
+            },
+        },
+    );
+    # Some time later...
+    $bar = Bar->new(\%attrib);
+    $bar->bend(@args);
+    $bar->stretch(@args);
+
+=head1 DESCRIPTION
+
+Provides a simple method to create CODE-based classes.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->class(\%attrib_opt,\%class_opt)
+
+Creates common methods for a CODE-based class.
+
+The %attrib_opt is used to configure the attributes of an instance of the class.
+The key of each element is the name of the attribute, and the value is a HASH
+containing the options of the attribute, or a SCALAR. (If a SCALAR is specified,
+it is equivalent to {isa => value}.) The options may contain:
+
+=over 4
+
+=item r
+
+(Default=true) If true, the attribute is readable.
+
+=item w
+
+(Default=true) If true, the attribute is writable.
+
+=item default
+
+(Default=undef) The default value of the attribute.
+
+If this option is defined, the attribute will be initialised to the specified
+value when the new() method is called. In the special case where the value of
+this option is a CODE reference, it will be invoked as $code->(\%attrib), and
+the default value will be the returned value of the CODE reference. This is
+useful, for example, if the default value needs to be a new instance of a class.
+If a genuine CODE reference is required as the default, this option should be
+set to a CODE reference that returns the required CODE reference itself.
+
+For example:
+
+    Foo->class({
+        foo => {default => 'foo'},          # 'foo'
+        bar => {default => sub {get_id()}}, # the next id
+        baz => {default => sub {\&code}},   # &code
+    });
+    {
+        my $id = 0;
+        sub get_id {$id++}
+    }
+
+If a default option is not defined, and if the attribute "isa" is ARRAY, HASH or
+CODE, then the default value is [], {} and sub {} respectively.
+
+=item isa
+
+(Default=undef) The expected type of the attribute. If this optioin is defined
+as $type, a new $value of the attribute is only accepted if $value is undef,
+UNIVERSAL::isa($value,$type) returns true or if $type is C<SCALAR> and the new
+value is not a reference.
+
+The attribute accepts $, @, %, & and * as aliases to SCALAR, ARRAY, HASH, CODE
+and GLOB.
+
+=back
+
+The %class_opt is used to configure what methods are created for the class, as
+well as other options for the $class->new() method. It may contain the
+following:
+
+=over 4
+
+=item init
+
+If $class_opt{init} is defined, it should be a CODE reference. If specified, it
+will be called once when $instance->new() is called, with the interface
+$init->(\%attrib,$self).
+
+=item init_attrib
+
+The value of this option must be a CODE. The $class->new() normally expects a
+single HASH reference argument. If an alternate interface to the $class->new()
+is required, this CODE can be used to turn the input argument list to the
+expected HASH reference.
+
+=item action_of
+
+This provides the actions of the class. It should be a HASH. Each $key in the
+HASH will be turned into a method implemented by the CODE reference in the
+corresponding $value: $instance->$key(@args) will call $instance->($key,@args),
+which will call $value->(\%attrib,@args).
+
+=back
+
+=item $class->new(\%attrib)
+
+Creates a new instance with %attrib. Initial values of the attributes can be
+specified using %attrib. Otherwise, the method will attempt to assign the
+default values, as specified in the class() method, to the newly created
+instance.
+
+=item $instance->$key(@args)
+
+A method is created for each $key of the %{$attrib{action_of}}.
+
+=back
+
+=head1 DIAGNOSTICS
+
+L<FCM::Class::Exception|FCM::Class::Exception> is thrown on error.
+
+=head1 SEE ALSO
+
+Inspired by the standard module L<Class::Struct|Class::Struct> and CPAN modules
+such as L<Class::Accessor|Class::Accessor>.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Class/Exception.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Class/Exception.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Class/Exception.pm	(revision 5095)
@@ -0,0 +1,134 @@
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+#-------------------------------------------------------------------------------
+package FCM::Class::Exception;
+
+use constant {
+    CODE_TYPE => 'CODE_TYPE',
+};
+
+sub caught {
+    my ($class, $e) = @_;
+    blessed($e) && $e->isa($class);
+}
+
+sub throw {
+    my ($class, $attrib_ref) = @_;
+    my %e = (
+        'caller'  => [],
+        'code'    => undef,
+        'key'     => undef,
+        'package' => undef,
+        'type'    => undef,
+        'value'   => undef,
+        (defined($attrib_ref) ? %{$attrib_ref} : ()),
+    );
+    die(bless(\%e, $class));
+}
+
+for my $key (qw{caller code key package type value}) {
+    no strict qw{refs};
+    *{"get_$key"} = sub {$_[0]->{$key}};
+}
+
+#-------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Class::Exception
+
+=head1 SYNOPSIS
+
+    eval {
+        FCM::Class::Exception->throw({
+            'caller'  => [caller()],
+            'code'    => $code,
+            'key'     => $key,
+            'package' => $package,
+            'type'    => $type,
+            'value'   => $value,
+        });
+    };
+    if (my $e = $@) {
+        if (FCM::Class::Exception->caught($e)) {
+            # ... handle this exception class
+        }
+        else {
+            # ... do something else
+        }
+    }
+
+=head1 DESCRIPTION
+
+This exception is thrown on incorrect usage of an instance of a sub-class. An
+instance of this exception has the following attributes, which can be accessed
+via $e->get_$attrib():
+
+=head1 ATTRIBUTES
+
+=over 4
+
+=item caller
+
+Returns an ARRAY reference containing the caller (as returned by the built-in
+function in ARRAY context) that triggers the exception. Note: for a CODE-based
+class, this is always the caller when the instance is created.
+
+=item code
+
+The error code, which can be one of the following:
+
+=over 4
+
+=item $e->CODE_TYPE
+
+Attempt to set the value of an attribute to an incorrect type.
+
+=back
+
+=item key
+
+The key of the attribute that triggers this exception.
+
+=item type
+
+The expected data type (for an attempt to set the value of an attribute to an
+incorrect type).
+
+=item value
+
+The value of the attribute that triggers this exception.
+
+=back
+
+=head1 SEE ALSO
+
+L<FCM::Class::CODE|FCM::Class::CODE>
+L<FCM::Class::HASH|FCM::Class::HASH>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Class/HASH.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Class/HASH.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Class/HASH.pm	(revision 5095)
@@ -0,0 +1,340 @@
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+#-------------------------------------------------------------------------------
+package FCM::Class::HASH;
+use FCM::Class::Exception;
+use Scalar::Util qw{reftype};
+
+# Methods for working out the default value of an attribute.
+my %ATTRIB_DEFAULT_BY = (
+    default => sub {
+        my $opt_ref = shift();
+        my $ret = $opt_ref->{default};
+        return (ref($ret) && reftype($ret) eq 'CODE' ? $ret->() : $ret);
+    },
+    isa     => sub {
+        my $opt_ref = shift();
+        return
+              $opt_ref->{isa} eq 'ARRAY' ? []
+            : $opt_ref->{isa} eq 'HASH'  ? {}
+            : $opt_ref->{isa} eq 'CODE'  ? sub {}
+            :                              undef
+            ;
+    },
+);
+
+# Checks the value of an attribute.
+my $ATTRIB_CHECK = sub {
+    my ($class, $opt_ref, $key, $value, $caller_ref) = @_;
+    # Note: undef is always OK?
+    if (!defined($value)) {
+        return;
+    }
+    my $expected_isa = $opt_ref->{isa};
+    if (!$expected_isa || $expected_isa eq 'SCALAR' && !ref($value)) {
+        return;
+    }
+    if (!UNIVERSAL::isa($value, $expected_isa)) {
+        return FCM::Class::Exception->throw({
+            'code'    => FCM::Class::Exception->CODE_TYPE,
+            'caller'  => $caller_ref,
+            'package' => $class,
+            'key'     => $key,
+            'type'    => $expected_isa,
+            'value'   => $value,
+        });
+    }
+};
+
+# Creates the methods of the class.
+sub class {
+    my ($class, $attrib_opt_ref, $class_opt_ref) = @_;
+    my %class_opt = (
+        init        => sub {},
+        init_attrib => sub {@_},
+        (defined($class_opt_ref) ? %{$class_opt_ref} : ()),
+    );
+    if (!defined($attrib_opt_ref)) {
+        $attrib_opt_ref = {};
+    }
+    my %attrib_opt;
+    while (my ($key, $item) = each(%{$attrib_opt_ref})) {
+        my %option = (
+            r       => 1,     # readable?
+            w       => 1,     # writable?
+            add     => undef, # isa eq 'HASH' only, class of HASH element
+            default => undef, # default value or CODE to return it
+            isa     => undef, # attribute type
+            (     defined($item) && ref($item) ? %{$item}
+                : defined($item)               ? (isa => $item)
+                :                                ()
+            ),
+        );
+        if (defined($option{isa})) {
+            $option{isa}
+                = $option{isa} eq '$' ? 'SCALAR'
+                : $option{isa} eq '@' ? 'ARRAY'
+                : $option{isa} eq '%' ? 'HASH'
+                : $option{isa} eq '&' ? 'CODE'
+                : $option{isa} eq '*' ? 'GLOB'
+                :                       $option{isa}
+                ;
+        }
+        $attrib_opt{$key} = \%option;
+    }
+    no strict qw{refs};
+    # $class->new(\%attrib)
+    *{$class . '::new'} = sub {
+        my $class = shift();
+        my ($attrib_ref) = $class_opt{init_attrib}->(@_);
+        my $caller_ref = [caller()];
+        my %attrib = (defined($attrib_ref) ? %{$attrib_ref} : ());
+        while (my ($key, $value) = each(%attrib)) {
+            $ATTRIB_CHECK->($class, $attrib_opt{$key}, $key, $value, $caller_ref);
+        }
+        my $self = bless(\%attrib, $class);
+        KEY:
+        while (my ($key, $opt_ref) = each(%attrib_opt)) {
+            if (exists($self->{$key})) {
+                next KEY;
+            }
+            for my $opt_name (qw{default isa}) {
+                if (defined($opt_ref->{$opt_name})) {
+                    $self->{$key} = $ATTRIB_DEFAULT_BY{$opt_name}->($opt_ref);
+                    next KEY;
+                }
+            }
+        }
+        $class_opt{init}->($self);
+        return $self;
+    };
+    # $instance->$methods()
+    while (my ($key, $opt_ref) = each(%attrib_opt)) {
+        # $instance->get_$attrib()
+        # $instance->get_$attrib($name)
+        if ($opt_ref->{r}) {
+            *{$class . '::get_' . $key}
+                = defined($opt_ref->{isa}) && $opt_ref->{isa} eq 'HASH'
+                ? sub {
+                    my ($self, $name) = @_;
+                    if (!defined($name)) {
+                        return $self->{$key};
+                    }
+                    if (exists($self->{$key}{$name})) {
+                        return $self->{$key}{$name};
+                    }
+                    return;
+                }
+                : sub {$_[0]->{$key}}
+                ;
+        }
+        # $instance->set_$attrib($value)
+        if ($opt_ref->{w}) {
+            *{$class . '::set_' . $key} = sub {
+                my ($self, $value) = @_;
+                $ATTRIB_CHECK->(
+                    $class, $attrib_opt{$key}, $key, $value, [caller()],
+                );
+                $self->{$key} = $value;
+                return $self;
+            };
+        }
+        # $instance->add_$attrib($name,\%option)
+        if (   defined($opt_ref->{isa}) && $opt_ref->{isa} eq 'HASH'
+            && defined($opt_ref->{add})
+        ) {
+            *{$class . '::add_' . $key} = sub {
+                my ($self, $name, @args) = @_;
+                if (defined($self->{$key}{$name})) {
+                    return $self->{$key}{$name};
+                }
+                $self->{$key}{$name} = $opt_ref->{add}->new(@args);
+            };
+        }
+    }
+    return 1;
+}
+
+#-------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Class::HASH
+
+=head1 SYNOPSIS
+
+    package Breakfast;
+    use base qw{FCM::Class::HASH};
+    __PACKAGE__->class(
+        {
+            eggs  => {isa => '@'},
+            ham   => {isa => '%'},
+            bacon => '$',
+            # ...
+        },
+    );
+    # Some time later...
+    $breakfast = Breakfast->new(\%attrib);
+    @eggs = @{$breakfast->get_eggs()};
+    $breakfast->set_ham(\%ham);
+
+=head1 DESCRIPTION
+
+Provides a simple method to create HASH-based classes.
+
+The class() method creates the new() method for initiating a new instance. It
+also provides a get_$attrib() and set_$attrib() accessors for each attribute.
+Basic type checkings are performed on writing to the attributes to ensure
+correct usage.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->class(\%attrib_opt,\%class_opt)
+
+Creates the class, using the attribute options in %attrib_opt and %class_opt.
+
+The %attrib_opt is used to configure the attributes of an instance of the class.
+The key of each element is the name of the attribute, and the value is a HASH
+containing the options of the attribute, or a SCALAR. (If a SCALAR is specified,
+it is equivalent to {isa => value}.). The options may contain:
+
+=over 4
+
+=item r
+
+(Default=true) If true, the attribute is readable.
+
+=item w
+
+(Default=true) If true, the attribute is writable.
+
+=item add
+
+(Default=undef) This is only useful for a HASH attribute. If defined, it should
+be the name of a class (e.g. $attrib_class). The HASH attribute will receive an
+extra method $instance->add_$attrib($key,@args). The method will assign the
+$name element of the HASH attribute to the result of $attrib_class->new(@args).
+
+=item default
+
+(Default=undef) The default value of the attribute.
+
+If this option is defined, the attribute will be initialised to the specified
+value when the new() method is called. In the special case where the value of
+this option is a CODE reference, it will be invoked as $code->(\%attrib), and
+the default value will be the returned value of the CODE reference. This is
+useful, for example, if the default value needs to be a new instance of a class.
+If a genuine CODE reference is required as the default, this option should be
+set to a CODE reference that returns the required CODE reference itself.
+
+For example:
+
+    Foo->class({
+        foo => {default => 'foo'},          # 'foo'
+        bar => {default => sub {get_id()}}, # the next id
+        baz => {default => sub {\&code}},   # &code
+    });
+    {
+        my $id = 0;
+        sub get_id {$id++}
+    }
+
+If the default options is not defined, and if the attribute "isa" is ARRAY, HASH
+or CODE, then the default value is [], {} and sub {} respectively.
+
+=item isa
+
+(Default=undef) The expected type of the attribute. If this optioin is defined
+as $type, a new $value of the attribute is only accepted if $value is undef,
+UNIVERSAL::isa($value,$type) returns true or if $type is C<SCALAR> and the new
+value is not a reference.
+
+The attribute accepts $, @, %, & and * as aliases to SCALAR, ARRAY, HASH, CODE
+and GLOB.
+
+=back
+
+The argument %class_opt can have the following elements:
+
+=over 4
+
+=item init
+
+If $class_opt{init} is defined, it should be a CODE reference. If specified, it
+will be called just after the instance is blessed in the $class->new() method,
+with an interface $f->($instance) where $instance is the new instance.
+
+=item init_attrib
+
+The value of this option must be a CODE. The $class->new() normally expects a
+single HASH reference argument. If an alternate interface to the $class->new()
+is required, this CODE can be used to turn the input argument list to the
+expected HASH reference.
+
+=back
+
+=item $class->new(\%attrib)
+
+Creates a new instance with %attrib. Initial values of the attributes can be
+specified using %attrib. Otherwise, the method will attempt to assign the
+default values, as specified in the class() method, to the newly created
+instance.
+
+=item $instance->get_$attrib()
+
+Returns a readable attribute.
+
+=item $instance->get_$attrib($key)
+
+These are available for HASH attributes only. Returns the value of an element in
+a readable attribute.
+
+=item $instance->set_$attrib($value)
+
+Sets the value of a writable attribute. Returns $instance.
+
+=item $instance->add_$attrib($key,@args)
+
+These are available for HASH attributes (with the C<add> attribute option
+defined) only. Adds a new $key element to the HASH attribute. Returns the newly
+added element.
+
+=back
+
+=head1 DIAGNOSTICS
+
+L<FCM::Class::Exception|FCM::Class::Exception> is thrown on error.
+
+=head1 SEE ALSO
+
+Inspired by the standard module L<Class::Struct|Class::Struct> and CPAN modules
+such as L<Class::Accessor|Class::Accessor>.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/ConfigEntry.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/ConfigEntry.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/ConfigEntry.pm	(revision 5095)
@@ -0,0 +1,160 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Context::ConfigEntry;
+use base qw{FCM::Class::HASH};
+
+use Text::ParseWords qw{shellwords};
+
+__PACKAGE__->class({
+    label       => '$',
+    modifier_of => '%',
+    ns_list     => '@',
+    stack       => '@',
+    value       => '$',
+});
+
+# A shorthand for shellwords($entry->get_value()).
+sub get_values {
+    shellwords($_[0]->get_value());
+}
+
+# The config entry's left hand side of the equal sign.
+sub get_lhs {
+    my ($self) = @_;
+    my $modifier = join(
+        q{, },
+        (   map
+            {   my $value = $self->{modifier_of}{$_};
+                join(q{:}, $_, (($value && $value eq 1) ? () : $value));
+            }
+            sort keys(%{$self->{modifier_of}})
+        ),
+    );
+    my $ns = join(
+        q{ },
+        (map {my $s = $_; $s =~ s{(["'\s])}{\\$1}gxms; $s} @{$self->{ns_list}}),
+    );
+    sprintf(
+        '%s%s%s',
+        $self->{label},
+        ($modifier ? "{$modifier}" : q{}),
+        ($ns ? "[$ns]" : q{}),
+    );
+}
+
+# The config entry, as a string.
+sub as_string {
+    my ($self, $in_fcm1) = @_;
+    my $value = $self->{value};
+    $value ||= q{};
+    $value =~ s{(\\)+(\$)}{$1$1\\$2}gxms;
+    sprintf(($in_fcm1 ? '%s %s' : '%s = %s'), $self->get_lhs(), $value);
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::Context::ConfigEntry;
+
+=head1 SYNOPSIS
+
+    my $c_entry = FCM::Context::ConfigEntry->new({
+        label       => 'egg',
+        modifier_of => {fried => 1},
+        ns_list     => [qw{all day breakfast}],
+        stack       => [[$breakfast_menu, 10], [$menu, 20]],
+        value       => 2,
+    });
+
+    # ... some time later
+    $label       = $c_entry->get_label();
+    %modifier_of = %{$c_entry->get_modifier_of()};
+    @ns_list     = @{$c_entry->get_ns_list()};
+    @stack       = @{$c_entry->get_stack()};
+    $value       = $c_entry->get_value();
+
+    print($c_entry->as_string());
+    # should print: egg{fried: 1}[all day breakfast] = 2
+
+=head1 DESCRIPTION
+
+This class is based on L<FCM::Class::HASH|FCM::Class::HASH> for representing an
+entry in a FCM configuration file. All attributes can be read using the
+$instance->get_$attrib() methods.
+
+=head1 ATTRIBUTES
+
+=over 4
+
+=item label
+
+The label of the entry.
+
+=item modifier_of
+
+A HASH containing the modifiers of this entry.
+
+=item ns_list
+
+An ARRAY containing the namespaces of this entry.
+
+=item stack
+
+An ARRAY containing the locator stack that provides this entry. The first
+element represents the top of the stack. Each element should be a reference to a
+2-element array [RESOURCE, LINE_NUMBER].
+
+=item value
+
+The value of this entry.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item $instance->as_string($in_fcm1)
+
+Returns a string representation of the config entry. If the optional argument
+$in_fcm1 is specified, it will return the config entry in FCM 1 format.
+
+=item $instance->get_lhs()
+
+Returns a string representation of the left hand side of the config entry.
+
+=item $instance->get_values()
+
+A shorthand for shellwords($instance->get_value()).
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Event.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Event.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Event.pm	(revision 5095)
@@ -0,0 +1,383 @@
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+use strict;
+use warnings;
+#-------------------------------------------------------------------------------
+
+package FCM::Context::Event;
+use base qw{FCM::Class::HASH};
+
+use constant {
+    CM_ABORT                      => 'CM_ABORT',
+    CM_BRANCH_CREATE_SOURCE       => 'CM_BRANCH_CREATE_SOURCE',
+    CM_BRANCH_LIST                => 'CM_BRANCH_LIST',
+    CM_COMMIT_MESSAGE             => 'CM_COMMIT_MESSAGE',
+    CM_CONFLICT_TEXT              => 'CM_CONFLICT_TEXT',
+    CM_CONFLICT_TEXT_SKIP         => 'CM_CONFLICT_TEXT_SKIP',
+    CM_CONFLICT_TREE              => 'CM_CONFLICT_TREE',
+    CM_CONFLICT_TREE_SKIP         => 'CM_CONFLICT_TREE_SKIP',
+    CM_CONFLICT_TREE_TIME_WARN    => 'CM_CONFLICT_TREE_TIME_WARN',
+    CM_CREATE_TARGET              => 'CM_CREATE_TARGET',
+    CM_LOG_EDIT                   => 'CM_LOG_EDIT',
+    #CM_WC_STATUS                  => 'CM_WC_STATUS',
+    #CM_WC_STATUS_PATH             => 'CM_WC_STATUS_PATH',
+    CONFIG_OPEN                   => 'CONFIG_OPEN',
+    CONFIG_ENTRY                  => 'CONFIG_ENTRY',
+    CONFIG_VAR_UNDEF              => 'CONFIG_VAR_UNDEF',
+    E                             => 'E',
+    EXPORT_ITEM_CREATE            => 'EXPORT_ITEM_CREATE',
+    EXPORT_ITEM_DELETE            => 'EXPORT_ITEM_DELETE',
+    FCM_VERSION                   => 'FCM_VERSION',
+    KEYWORD_ENTRY                 => 'KEYWORD_ENTRY',
+    OUT                           => 'OUT',
+    MAKE_BUILD_SHELL_OUT          => 'MAKE_BUILD_SHELL_OUT',
+    MAKE_BUILD_SOURCE_ANALYSE     => 'MAKE_BUILD_SOURCE_ANALYSE',
+    MAKE_BUILD_SOURCE_SUMMARY     => 'MAKE_BUILD_SOURCE_SUMMARY',
+    MAKE_BUILD_TARGET_DONE        => 'MAKE_BUILD_TARGET_DONE',
+    MAKE_BUILD_TARGET_FAIL        => 'MAKE_BUILD_TARGET_FAIL',
+    MAKE_BUILD_TARGET_FROM_NS     => 'MAKE_BUILD_TARGET_FROM_NS',
+    MAKE_BUILD_TARGET_MISSING_DEP => 'MAKE_BUILD_TARGET_MISSING_DEP',
+    MAKE_BUILD_TARGET_SELECT      => 'MAKE_BUILD_TARGET_SELECT',
+    MAKE_BUILD_TARGET_SELECT_TIMER=> 'MAKE_BUILD_TARGET_SELECT_TIMER',
+    MAKE_BUILD_TARGET_STACK       => 'MAKE_BUILD_TARGET_STACK',
+    MAKE_BUILD_TARGET_SUMMARY     => 'MAKE_BUILD_TARGET_SUMMARY',
+    MAKE_BUILD_TARGET_TASK_SUMMARY=> 'MAKE_BUILD_TARGET_TASK_SUMMARY',
+    MAKE_BUILD_TARGETS_FAIL       => 'MAKE_BUILD_TARGETS_FAIL',
+    MAKE_DEST                     => 'MAKE_DEST',
+    MAKE_EXTRACT_PROJECT_TREE     => 'MAKE_EXTRACT_PROJECT_TREE',
+    MAKE_EXTRACT_RUNNER_SUMMARY   => 'MAKE_EXTRACT_RUNNER_SUMMARY',
+    MAKE_EXTRACT_SYMLINK          => 'MAKE_EXTRACT_SYMLINK',
+    MAKE_EXTRACT_TARGET           => 'MAKE_EXTRACT_TARGET',
+    MAKE_EXTRACT_TARGET_SUMMARY   => 'MAKE_EXTRACT_TARGET_SUMMARY',
+    MAKE_MIRROR                   => 'MAKE_MIRROR',
+    SHELL                         => 'SHELL',
+    TASK_WORKERS                  => 'TASK_WORKERS',
+    TIMER                         => 'TIMER',
+};
+
+__PACKAGE__->class({args => '@', code => '$'});
+
+#-------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Context::Event
+
+=head1 SYNOPSIS
+
+    use FCM::Context::Event;
+    my $event_ctx = FCM::Context::Event->new($code, @args);
+
+=head1 DESCRIPTION
+
+An instance of this class represents the context of an event. This class is a
+sub-class of L<FCM::Class::HASH|FCM::Class::HASH>.
+
+=head1 ATTRIBUTES
+
+=over 4
+
+=item args
+
+An ARRAY reference that represents the additional arguments/contexts of the
+event.
+
+=item code
+
+The event code. See below
+
+=back
+
+=head1 EVENTS
+
+The following is a list of event codes.
+
+=over 4
+
+=item FCM::Context::Event->CM_ABORT
+
+This event is raised when a code management command aborts. The 1st argument
+should be either "user" (user abort) or "null" (null command).
+
+=item FCM::Context::Event->CM_BRANCH_CREATE_SOURCE
+
+This event is raised to notify the source of a branch create. The 1st argument
+should be the expected source URL, and the 2nd argument is the specified peg
+revision.
+
+=item FCM::Context::Event->CM_BRANCH_LIST
+
+This event is raised when doing a branch listing. The 1st argument should be the
+project location and the rest of the arguments are the branches discovered.
+
+=item FCM::Context::Event->CM_COMMIT_MESSAGE
+
+This event is raised to notify the user the log message to be used for a commit.
+The 1st argument of the event should be an instance of
+FCM::System::CM::CommitMessage::State.
+
+=item FCM::Context::Event->CM_CONFLICT_TEXT
+
+This event is raised to notify the path of a file with a text conflict.
+
+=item FCM::Context::Event->CM_CONFLICT_TEXT_SKIP
+
+This event is raised to notify the path of a file with a text conflict that
+cannot be resolved using a merge tool. E.g. it may be a binary file.
+
+=item FCM::Context::Event->CM_CONFLICT_TREE
+
+This event is raised to notify the path of a node with a tree conflict.
+
+=item FCM::Context::Event->CM_CONFLICT_TREE_SKIP
+
+This event is raised to notify the path of a node with a tree conflict that
+cannot be resolved automatically under current functionality. For example, it
+may be a directory containing multiple conflicts.
+
+=item FCM::Context::Event->CM_CREATE_TARGET
+
+This event is raised to notify the target of a newly created URL. The 1st argument
+should be the target URL.
+
+=item FCM::Context::Event->CM_LOG_EDIT
+
+This event is raised before the system launches an editor to edit a commit log
+message. The 1st argument of the event should be the editor command.
+
+=item FCM::Context::Event->CONFIG_ENTRY
+
+This entry is raised to notify the reading of a configuration file entry. The
+1st argument should be a blessed reference of a
+L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry>. The second argument
+should be a boolean flag to indicate whether this entry is in FCM 1 format or
+not.
+
+=item FCM::Context::Event->CONFIG_OPEN
+
+This event is raised when a new configuration file is opened for reading. The
+1st argument of this event is an ARRAY that represents the include file stack,
+where the last element is the top of the stack. Each element of the stack is a
+2-element ARRAY reference, where the first element is a
+L<FCM::Context::Locator|FCM::Context::Locator> object and the second element is
+the line number. (At the top of the stack, the line number is set to 0.) The 2nd
+optional argument of this event is a number to adjust the verbosity level of the
+event.
+
+=item FCM::Context::Event->CONFIG_VAR_UNDEF
+
+This event is raised when a variable is undefined. The arguments of this event
+contain 2 elements. The 1st element is the configuration entry as a blessed
+reference of L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry>. The 2nd
+element is the name of the variable.
+
+=item FCM::Context::Event->E
+
+This event is raised when to notify an exception. The 1st argument of this event
+should be the exception.
+
+=item FCM::Context::Event->EXPORT_ITEM_CREATE
+
+This event is raised when the export-items system creates a link to an item.
+The 1st argument is the namespace of the item, the 2nd argument is the revision
+of the item and the 3rd argument is the name of the link.
+
+=item FCM::Context::Event->EXPORT_ITEM_DELETE
+
+This event is raised when the export-items system deletes a link to an item.
+The 1st argument is the namespace of the item, the 2nd argument is the revision
+of the item and the 3rd argument is the name of the link.
+
+=item FCM::Context::Event->FCM_VERSION
+
+This event is raised to notify the FCM version.
+
+=item FCM::Context::Event->KEYWORD_ENTRY
+
+This event is raised to notify a keyword entry. The 1st argument is the keyword
+entry as a blessed reference of FCM::Context::Keyword::Entry as described in
+L<FCM::Context::Keyword|FCM::Context::Keyword>.
+
+=item FCM::Context::Event->MAKE_BUILD_SHELL_OUT
+
+This event is raised to notify (shell command) output from make/build. The 1st
+argument should be the STDOUT, and the 2nd argument should be the STDERR.
+
+=item FCM::Context::Event->MAKE_BUILD_SOURCE_ANALYSE
+
+This event is raised when the make/build system has analysed a source file. The
+1st argument should be a blessed reference of FCM::Context::Make::Build::Source
+as described in L<FCM::Context::Make::Build|FCM::Context::Make::Build>. The 2nd
+argument should be the time it takes for the analysis.
+
+=item FCM::Context::Event->MAKE_BUILD_SOURCE_SUMMARY
+
+This event is raised when the make/build system has analysed all its source
+files. The 1st argument should be the total number of files. The 2nd argument
+should be the number analysed. The 3rd argument should be the elapsed time. The
+4th argument should be the total time, which may differ from the elapsed time if
+the analysis is run on more than 1 process.
+
+=item FCM::Context::Event->MAKE_BUILD_TARGET_DONE
+
+This event is raised when the make/build system has successfully updated a
+target or an update is unnecessary. The 1st argument is the target (as an
+instance of FCM::Context::Make::Build::Target), the 2nd argument is the elapsed
+time of the update, if relevant.
+
+=item FCM::Context::Event->MAKE_BUILD_TARGET_FAIL
+
+This event is raised when the make/build system failed to update a target or the
+target is failed by its dependencies. The 1st argument is the target (as an
+instance of FCM::Context::Make::Build::Target), the 2nd argument is the elapsed
+time, if the target is failed by its update.
+
+=item FCM::Context::Event->MAKE_BUILD_TARGET_FROM_NS
+
+This event is raised when the make/build system has generated a build target
+from a source or a source name-space. The arguments are: source/target
+namespace, target task, target category, and the target key.
+
+=item FCM::Context::Event->MAKE_BUILD_TARGET_MISSING_DEP
+
+This event is raised when the make/build system has discarded a missing
+dependency from a target. The 1st argument is the target ID, the 2nd argument is
+the dependency ID, and the 3rd argument is the dependency type.
+
+=item FCM::Context::Event->MAKE_BUILD_TARGET_SELECT
+
+This event is raised when the make/build system has selected a set of targets to
+build. The 1st argument is a HASH reference of the target set.
+
+=item FCM::Context::Event->MAKE_BUILD_TARGET_SELECT_TIMER
+
+This event is raised when the make/build system has completed the target select
+and dependency tree analysis. The only argument is the elapsed time.
+
+=item FCM::Context::Event->MAKE_BUILD_TARGET_STACK
+
+This event is raised when make/build system checks a target for cyclic
+dependency.  The 1st argument is the key of the task. The 2nd argument is rank
+of the task in the dependency hierarchy. The 3rd argument is the number of
+dependencies the task has if the task has already been checked, or undef if this
+is the first check for the task.
+
+=item FCM::Context::Event->MAKE_BUILD_TARGET_SUMMARY
+
+This event is raised when the make/build system has finished updating its
+targets, and is ready to give a total summary. The 1st argument is the number of
+modified targets, the 2nd argument is the number unchanged, the 3rd argument is
+the number failed, the 4th argument is the elapsed time.
+
+=item FCM::Context::Event->MAKE_BUILD_TARGET_TASK_SUMMARY
+
+This event is raised when the make/build system has finished updating its
+targets, and is ready to give a summary of each type of task. The 1st argument
+is the task type name, the 2nd argument is the number of modified targets, the
+3rd argument is the number unchanged, the 4th argument is the number failed, and
+the 5th argument is the total time spent on this task type.
+
+=item FCM::Context::Event->MAKE_BUILD_TARGETS_FAIL
+
+This event is raised when the make/build system has finished updating its
+targets, but some targets failed to update. The 1st argument is an ARRAY of
+FCM::Context::Make::Build::Target objects representing the failed targets.
+
+=item FCM::Context::Event->MAKE_DEST
+
+This event is raised when the make system sets up the destination. The 1st
+argument of this event is the make system context.
+
+=item FCM::Context::Event->MAKE_EXTRACT_PROJECT_TREE
+
+This event is raised after the make/extract system has finished gathering
+information for the source trees of each project. The 1st argument is a HASH of
+the (keys) project name-spaces and the (values) list (ARRAY) of source tree
+locators L<FCM::Context::Locator|FCM::Context::Locator> in the project.
+
+=item FCM::Context::Event->MAKE_EXTRACT_RUNNER_SUMMARY
+
+This event is raised after the make/extract system has finished using the task
+runner to perform some tasks. The 1st argument is an identifier for the tasks
+performed. The 2nd argument is the number of tasks. The 2nd argument is the
+elapsed time. The 3rd argument is the total time in all processes.
+
+=item FCM::Context::Event->MAKE_EXTRACT_SYMLINK
+
+This event is raised as the make/extract system ignores a source that is a
+symbolic link. The 1st argument of this event should be a blessed reference of
+FCM::Context::Make::Extract::Source as described in
+L<FCM::Context::Make::Extract|FCM::Context::Make::Extract>.
+
+=item FCM::Context::Event->MAKE_EXTRACT_TARGET
+
+This event is raised as the make/extract system updates a target destination. The
+1st argument of this event should be a blessed reference of
+FCM::Context::Make::Extract::Target as described in
+L<FCM::Context::Make::Extract|FCM::Context::Make::Extract>.
+
+=item FCM::Context::Event->MAKE_EXTRACT_TARGET_SUMMARY
+
+This event is raised after the make/extract system has updated all target
+destinations. The 1st argument of this event is a HASH reference, which contains
+2 keys: status and status_of_source, i.e. the destination status of the targets
+and the source status of the targets respectively. The values of both are HASH
+references. The keys are the names of the status, and the values are the number
+of targets with the corresponding status.
+
+=item FCM::Context::Event->MAKE_MIRROR
+
+This event is raised as the make/mirror system updates a target destination. The
+1st argument of this event should be the target URI. The remaining arguments
+should be the source paths.
+
+=item FCM::Context::Event->OUT
+
+This event is raised to notify (shell command) output. The 1st argument should
+be the STDOUT, and the 2nd argument should be the STDERR.
+
+=item FCM::Context::Event->SHELL
+
+This event is raised to notify the completion of a shell command. The 1st
+argument is an ARRAY reference of the shell command. The 2nd argument is an
+integer to override the verbosity level. The 3rd argument is the return code and
+the 4th argument is the elapsed time.
+
+=item FCM::Context::Event->TASK_WORKERS
+
+This event is raised on initialisation and destruction of worker processes for
+the utility task runner. The 1st argument should either be "init" or "destroy".
+The 2nd argument should be the number of workers initialised/destroyed.
+
+=item FCM::Context::Event->TIMER
+
+This event is raised at the start and end of the utility timer. The 1st
+argument is the name of the piece of code to time. The 2nd argument is the start
+the timer. The 3rd argument is the elapsed time at the end. If the 3rd argument
+is not specified, it is the start of the timer.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Keyword.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Keyword.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Keyword.pm	(revision 5095)
@@ -0,0 +1,221 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::Context::Keyword;
+use base qw{FCM::Class::HASH};
+
+use constant {
+    BROWSER_CONFIG    => 'FCM::Context::Keyword::BrowserConfig',
+    ENTRY             => 'FCM::Context::Keyword::Entry',
+    ENTRY_OF_LOCATION => 'FCM::Context::Keyword::Entry::Location',
+};
+
+use Scalar::Util qw{blessed};
+
+__PACKAGE__->class({
+    entry_class    => {w => 0, isa => '$', default => ENTRY_OF_LOCATION},
+    entry_by_key   => {w => 0, isa => '%'},
+    entry_by_value => {w => 0, isa => '%'},
+});
+
+sub add_entry {
+    my $self = shift();
+    my ($key, $value, $entry);
+    if (blessed($_[0])) {
+        $entry = $_[0];
+        $key   = $entry->get_key();
+        $value = $entry->get_value();
+    }
+    else {
+        ($key, $value, my $attrib_ref) = @_;
+        $attrib_ref ||= {};
+        $entry = $self->get_entry_class()->new({
+            key => lc($key), value => $value, %{$attrib_ref},
+        });
+    }
+    $self->{entry_by_key}{lc($key)} = $entry;
+    $self->{entry_by_value}{$value} = $entry;
+    return $entry;
+}
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Keyword::BrowserConfig;
+use base qw{FCM::Class::HASH};
+
+__PACKAGE__->class({comp_pat => undef, loc_tmpl => '$', rev_tmpl => '$'});
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Keyword::Entry;
+use base qw{FCM::Class::HASH};
+
+__PACKAGE__->class({
+    key   => {w => 0, isa => '$'},
+    value => {w => 0, isa => '$'},
+});
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Keyword::Entry::Location;
+use base qw{FCM::Context::Keyword::Entry};
+
+my $CTX = 'FCM::Context::Keyword';
+
+__PACKAGE__->class(
+    {   browser_config  => $CTX->BROWSER_CONFIG,
+        ctx_of_implied  => $CTX,
+        ctx_of_rev      => $CTX,
+        implied         => {isa => '$', default => 0},
+        key             => {isa => '$', w => 0},
+        loaded_rev_prop => '$',
+        type            => '$',
+        value           => {isa => '$', w => 0},
+    },
+    {   init => sub {
+            my ($self) = @_;
+            if (!$self->get_implied()) {
+                $self->{browser_config} = $CTX->BROWSER_CONFIG->new();
+                $self->{ctx_of_implied} = $CTX->new();
+                $self->{ctx_of_rev} = $CTX->new({entry_class => $CTX->ENTRY});
+            }
+        },
+    },
+);
+
+# Returns true if this is an implied entry
+sub is_implied {
+    $_[0]->{implied};
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Context::Keyword
+
+=head1 SYNOPSIS
+
+    use FCM::Context::Keyword;
+
+=head1 DESCRIPTION
+
+Provides a context object for the FCM keyword utility. All the classes described
+below are sub-classes of L<FCM::Class::HASH|FCM::Class::HASH>.
+
+=head1 OBJECTS
+
+=head2 FCM::Context::Keyword
+
+An object of this class is used to store a list of keyword entries. It has the
+following methods:
+
+=over 4
+
+=item $instance->add_entry($key,$value,\%attrib)
+
+Creates and adds a new entry.
+
+=item $instance->add_entry($entry)
+
+Adds a new entry.
+
+=item $instance->get_entry_class()
+
+Returns the class of the entry stored by this context.
+
+=item $instance->get_entry_by_key()
+
+Returns a HASH reference to map the entry keys with the entry objects.
+
+=item $instance->get_entry_by_value()
+
+Returns a HASH reference to map the entry values with the entry objects.
+
+=back
+
+=head2 FCM::Context::Keyword::BrowserConfig
+
+An object of this class is used to store the configuration for mapping a
+location to a browser URL. It has the following attributes:
+
+=over 4
+
+=item comp_pat
+
+The pattern for extracting components from a locator, for putting into the
+browser location template.
+
+=item loc_tmpl
+
+The browser location template.
+
+=item rev_tmpl
+
+The browser revision template.
+
+=back
+
+=head2 FCM::Context::Keyword::Entry
+
+This is used to store a simple keyword entry (e.g. for revision keywords). It
+has 2 attributes, the I<key> and the I<value>.
+
+=head2 FCM::Context::Keyword::Entry::Location
+
+This is a sub-class of FCM::Context::Keyword::Entry, and is used to store a
+location keyword entry. It has the following additional attributes:
+
+=over 4
+
+=item browser_config
+
+The configuration L</FCM::Context::Keyword::BrowserConfig> for mapping this
+location to a browser URL.
+
+=item ctx_of_implied
+
+The context </FCM::Context::Keyword> object of the implied entries, if this
+entry is a primary location.
+
+=item ctx_of_rev
+
+The context </FCM::Context::Keyword> object of the revision keywords.
+
+=item implied
+
+A flag to indicate that this is an entry implied by a primary location.
+
+=item loaded_rev_prop
+
+A flag to indicate that a previous attempt is made to load revision keywords
+from the I<property> of the location.
+
+=item type
+
+The location type.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Locator.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Locator.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Locator.pm	(revision 5095)
@@ -0,0 +1,144 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::Context::Locator;
+use base qw{FCM::Class::HASH};
+
+use constant {
+    L_INIT       => -1,
+    L_PARSED     =>  0,
+    L_NORMALISED =>  1,
+    L_INVARIANT  =>  2,
+};
+
+__PACKAGE__->class(
+    {   last_mod_rev  => '$',
+        last_mod_time => '$',
+        type          => '$',
+        value         => '$',
+        value_at_init => {isa => '$', i => 1, w => 0},
+        value_level   => {isa => '$', default => L_INIT},
+    },
+    {   init_attrib => sub {
+            my ($value, $attrib_ref) = @_;
+            return {
+                (defined($attrib_ref) ? %{$attrib_ref} : ()),
+                value         => $value,
+                value_at_init => $value,
+            };
+        },
+    }
+);
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Context::Locator
+
+=head1 SYNOPSIS
+
+    use FCM::Context::Locator;
+    $locator = FCM::Context::Locator->new($value_at_init, {type => $type});
+    $locator->set_value($value);
+    $locator->set_value_level($locator->L_INVARIANT);
+    print($locator->get_value(), "\n");
+
+=head1 DESCRIPTION
+
+A simple structure for storing the values of a FCM locator. It is based on
+L<FCM::Class::HASH|FCM::Class::HASH>.
+
+=head1 ATTRIBUTES
+
+An instance has the following attributes, all of which can be initialised and
+accessed via an $instance->get_$attrib() method:
+
+=over 4
+
+=item last_mod_rev
+
+The last modified revision.
+
+=item last_mod_time
+
+The last modified time (seconds since epoch).
+
+=item type
+
+The locator type.
+
+=item value
+
+The current value of the locator.
+
+=item value_at_init
+
+The value of the locator when the object is initialised.
+
+=item value_level
+
+The value level of the locator. It can be one of the L_* constants. A higher
+level indicates that the value is more processed.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new($value,\%attrib)
+
+Returns a new instance.
+
+=head1 CONSTANTS
+
+=over 4
+
+=item FCM::Context::Locator->L_INIT
+
+The lowest value level, i.e. the value has not been processed. (default)
+
+=item FCM::Context::Locator->L_PARSED
+
+The value level is between L_INIT and L_NORMALISED, i.e. where necessary, the
+FCM location keyword is substituted.
+
+=item FCM::Context::Locator->L_NORMALISED
+
+The value level is between L_PARSED and L_INVARIANT, i.e. where necessary, the
+FCM location and revision keywords are substituted and the value has been tidied
+(e.g. extra slashes in the path removed).
+
+=item FCM::Context::Locator->L_INVARIANT
+
+The highest value level, i.e. if the locator points to a version control
+resource, the value is expected to be tagged with a specific revision.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make.pm	(revision 5095)
@@ -0,0 +1,176 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Make;
+use base qw{FCM::Class::HASH};
+
+use constant {
+    ST_UNKNOWN =>  0,
+    ST_INIT    =>  1,
+    ST_OK      =>  2,
+    ST_FAILED  => -1,
+};
+
+__PACKAGE__->class({
+    ctx_of            => '%',
+    description       => '$',
+    dest              => '$',
+    dest_lock         => '$',
+    error             => {},
+    inherit_ctx_list  => '@',
+    name              => {isa => '$', default => q{}},
+    option_of         => '%',
+    prev_ctx          => __PACKAGE__,
+    status            => {isa => '$', default => ST_UNKNOWN},
+    steps             => '@',
+});
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Context::Make
+
+=head1 SYNOPSIS
+
+    use FCM::Context::Make;
+    my $ctx = FCM::Context::Make->new();
+
+=head1 DESCRIPTION
+
+Provides a context object for the FCM make system. It is a sub-class of
+L<FCM::Class::HASH|FCM::Class::HASH>.
+
+=head1 OBJECTS
+
+=head2 FCM::Context::Make
+
+An instance of this class represents a make. It has the following
+attributes:
+
+=over 4
+
+=item ctx_of
+
+A HASH containing the (keys) IDs and the (values) context objects of the make.
+
+=item description
+
+A description string for this make.
+
+=item dest
+
+The destination of this make.
+
+=item dest_lock
+
+The destination lock of this make.
+
+=item error
+
+This should be set to the value of the exception, if this make ends in one.
+
+=item inherit_ctx_list
+
+An ARRAY of contexts inherited by this make.
+
+=item name
+
+The name of the context. This is useful if we need to have multiple (but
+non-overlapping) "fcm make" runs in the same destination. (Default is a null
+string.)
+
+=item option_of
+
+A HASH to store the options of this make. See L</OPTION> for detail.
+
+=item status
+
+The status of the make.
+
+=item steps
+
+The names of the steps to make.
+
+=back
+
+=head1 OPTION
+
+The C<option_of> attribute of a FCM::Context::Make object may contain the
+following elements:
+
+=over 4
+
+=item config-file
+
+An ARRAY of configuration file names.
+
+=item directory
+
+The working directory of the make.
+
+=item ignore-lock
+
+Ignores lock file in the destination.
+
+=item jobs
+
+The number of (child) threads that can be run simultaneously.
+
+=item new
+
+Performs a make in "new" mode (as opposed to the "incremental" mode).
+
+=back
+
+=head1 CONSTANTS
+
+=over 4
+
+=item FCM::Context::Make->ST_UNKNOWN
+
+The status of a make context or the context of a subsystem. Status is unknown.
+
+=item FCM::Context::Make->ST_INIT
+
+The status of a make context or the context of a subsystem. The make or the
+subsystem has initialised, but not completed.
+
+=item FCM::Context::Make->ST_OK
+
+The status of a make context or the context of a subsystem. The make or the
+subsystem has completed successfully.
+
+=item FCM::Context::Make->ST_FAILED
+
+The status of a make context or the context of a subsystem. The make or the
+subsystem has failed.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make/Build.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make/Build.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make/Build.pm	(revision 5095)
@@ -0,0 +1,481 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Make::Build;
+use base qw{FCM::Class::HASH};
+
+use FCM::Context::Make;
+
+use constant {
+    CTX_SOURCE  => 'FCM::Context::Make::Build::Source',
+    CTX_TARGET  => 'FCM::Context::Make::Build::Target',
+    ID_OF_CLASS => 'build',
+};
+
+my $ST_UNKNOWN = FCM::Context::Make->ST_UNKNOWN;
+
+__PACKAGE__->class(
+    {   dest             => '$',
+        dests            => '@',
+        id               => {isa => '$' , default => ID_OF_CLASS},
+        id_of_class      => {isa => '$' , default => ID_OF_CLASS},
+        input_ns_excl    => '@',
+        input_ns_incl    => '@',
+        input_source_of  => '%',
+        prop_of          => '%',
+        source_of        => '%',
+        status           => {isa => '$' , default => $ST_UNKNOWN},
+        target_of        => '%',
+        target_key_of    => '%',
+        target_select_by => '%',
+    },
+);
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Make::Build::Source;
+use base qw{FCM::Class::HASH};
+
+__PACKAGE__->class({
+    checksum   => '$',
+    deps       => '@',
+    info_of    => '%',
+    ns         => '$',
+    path       => '$',
+    prop_of    => '%',
+    type       => '$',
+    up_to_date => '$',
+});
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Make::Build::Target;
+use base qw{FCM::Class::HASH};
+
+use constant {
+    CT_BIN                  => 'bin',
+    CT_ETC                  => 'etc',
+    CT_INCLUDE              => 'include',
+    CT_LIB                  => 'lib',
+    CT_O                    => 'o',
+    CT_SRC                  => 'src',
+    POLICY_CAPTURE          => 'POLICY_CAPTURE',
+    POLICY_FILTER           => 'POLICY_FILTER',
+    POLICY_FILTER_IMMEDIATE => 'POLICY_FILTER_IMMEDIATE',
+    ST_FAILED               => 'ST_FAILED',
+    ST_MODIFIED             => 'ST_MODIFIED',
+    ST_OOD                  => 'ST_OOD',
+    ST_UNCHANGED            => 'ST_UNCHANGED',
+    ST_UNKNOWN              => 'ST_UNKNOWN',
+};
+
+__PACKAGE__->class(
+    {   category        => '$',
+        checksum        => '$',
+        deps            => '@',
+        dep_policy_of   => '%',
+        failed_by       => '@',
+        info_of         => '%',
+        key             => '$',
+        ns              => '$',
+        path            => '$',
+        path_of_prev    => '$',
+        path_of_source  => '$',
+        prop_of         => '%',
+        prop_of_prev_of => '%',
+        status          => {isa => '$', default => ST_UNKNOWN},
+        status_of       => '%',
+        task            => '$',
+        triggers        => '@',
+        type            => '$',
+    },
+);
+
+# Returns true if target has a usable dest status.
+sub can_be_source {
+    $_[0]->get_category() && $_[0]->get_category() eq CT_SRC;
+}
+
+# Returns true if target has an OK status.
+sub is_ok {
+    $_[0]->get_status() eq ST_MODIFIED || $_[0]->get_status() eq ST_UNCHANGED;
+}
+
+# Returns true if target has a failed status.
+sub is_failed {
+    $_[0]->get_status() eq ST_FAILED;
+}
+
+# Shorthand for $target->get_status() eq $target->ST_MODIFIED.
+sub is_modified {
+    $_[0]->get_status() eq ST_MODIFIED;
+}
+
+# Shorthand for $target->get_status() eq $target->ST_UNCHANGED.
+sub is_unchanged {
+    $_[0]->get_status() eq ST_UNCHANGED;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Context::Make::Build
+
+=head1 SYNOPSIS
+
+    use FCM::Context::Make::Build;
+    my $ctx = FCM::Context::Make::Build->new();
+
+=head1 DESCRIPTION
+
+Provides a context object for the FCM build system. All the classes described
+below are sub-classes of L<FCM::Class::HASH|FCM::Class::HASH>.
+
+=head1 OBJECTS
+
+=head2 FCM::Context::Make::Build
+
+An instance of this class represents a build. It has the following
+attributes:
+
+=over 4
+
+=item dest
+
+The destination of the build.
+
+=item dests
+
+An ARRAY containing the path for searching items in the current build.
+
+=item id
+
+The ID of the context. (default="build")
+
+=item id_of_class
+
+The class ID of the context. (default="build")
+
+=item input_source_of
+
+A HASH to map a name space to its ARRAY of input sources.
+
+=item input_ns_excl
+
+An ARRAY of source name-spaces to exclude.
+
+=item input_ns_incl
+
+An ARRAY of source name-spaces to include.
+
+=item prop_of
+
+A HASH containing the named properties (i.e. options and settings of named
+external tools). Expects a value to be an instance of
+L<FCM::Context::Make::Share::Property|FCM::Context::Make::Share::Property>.
+
+=item prop_of_prev_of
+
+A HASH containing the named properties (i.e. options and settings of named
+external tools) in the latest successful update of this target. Expects a value
+to be an instance of
+L<FCM::Context::Make::Share::Property|FCM::Context::Make::Share::Property>.
+
+=item source_of
+
+A HASH to map the namespace to the source contexts. Each element is expected to
+be an L</FCM::Context::Make::Build::Source> object.
+
+=item status
+
+The status of this context. See L<FCM::Context::Make|FCM::Context::Make> for the
+status constants.
+
+=item target_of
+
+A HASH to map the namespace to the target contexts. Each element is expected to
+be an L</FCM::Context::Make::Build::Target> object.
+
+=item target_key_of
+
+A HASH to map the automatic key of targets to their desired key.
+
+=item target_select_by
+
+A HASH to allow users to specify how to select from all the targets. The key can
+be "category", "key", "ns" or "task". Each value should be a HASH that
+represents the set of criteria.
+
+=back
+
+=head2 FCM::Context::Make::Build::Source
+
+An instance of this class represents an actual source of the build. It has the
+following attributes:
+
+=over 4
+
+=item checksum
+
+The checksum of the source file.
+
+=item deps
+
+An ARRAY to contain the dependencies of the source file. Each element of the
+ARRAY is expected to be a reference to a two-element ARRAY [$name, $type] where
+$name is the name of the dependency and $type is its type.
+
+=item info_of
+
+A HASH to contain the extra information of the source file. E.g. If the {main}
+element is true, the source contains a main program. If the {symbols} element
+is defined, it contains a reference to an ARRAY of program unit symbols that has
+been found in the source file.
+
+=item ns
+
+The name-space of the source file.
+
+=item path
+
+The path in the file system pointing to the source file.
+
+=item prop_of
+
+A HASH containing the keys and the values of the build properties (mainly on
+dependency settings) of the source.
+
+=item type
+
+The file type of the source file.
+
+=item up_to_date
+
+A flag to indicate whether the source file is up to date, compared with a
+previous build or the nearest inherited build.
+
+=back
+
+=head2 FCM::Context::Make::Build::Target
+
+An instance of this class represents a target of the build. It has the following
+attributes:
+
+=over 4
+
+=item category
+
+The target category, e.g. bin, etc, include, lib, o, src
+
+=item checksum
+
+The checksum of the target.
+
+=item deps
+
+An ARRAY containing the dependencies of the target. Each element of the
+ARRAY is expected to be a reference to a two-element ARRAY [$name, $type] where
+$name is the name of the dependency and $type is its type.
+
+=item dep_policy_of
+
+A HASH to contain a map between each relevant dependency type of this target and
+its policy to apply to the dependency type. The policy should take the value of
+POLICY_CAPTURE, POLICY_FILTER or POLICY_FILTER_IMMEDIATE.
+
+=item failed_by
+
+On failure, set to an ARRAY containing the names of the targets that cause the
+failure of this target.
+
+=item info_of
+
+A HASH to contain the extra information of the target. E.g. The {paths} => ARRAY
+reference of include/object search paths for the compile, link and preprocess
+tasks; and {deps}{o} => ARRAY reference and {deps}{o.special} => ARRAY
+reference of object dependency for the link tasks.
+
+=item key
+
+The key (i.e. the base name) of the target.
+
+=item ns
+
+The name-space (of the source file) associated with this target.
+
+=item path
+
+The path in the file system where the target can be located.
+
+=item path_of_prev
+
+The path in the file system where the target in a previous or inherited build
+can be located.
+
+=item path_of_source
+
+The path in the file system where the source file associated with the target can
+be located.
+
+=item prop_of
+
+A HASH containing the keys and the values of the build properties of the target.
+
+=item status
+
+The status of the target.
+
+=item status_of
+
+A HASH containing the status of dependency types that may be relevant to targets
+higher up in the dependency tree.
+
+=item task
+
+The target type, (i.e. the name of the task to update with the target).
+
+=item triggers
+
+An ARRAY reference of the keys of targets that should be automatically triggered
+by this target.
+
+=item type
+
+The type of the source that gives this target.
+
+=back
+
+In addition, an instance of FCM::Context::Make::Extract::Target has the
+following methods:
+
+=over 4
+
+=item $target->can_be_source()
+
+Returns true if the destination status indicates that the target is usable as a
+source file of a subsequent a make (step).
+
+=item $target->is_ok()
+
+Returns true if the target has a OK destination status.
+
+=item $target->is_failed()
+
+Returns true if the target has a failed destination status.
+
+=item $target->is_modified()
+
+Shorthand for $target->get_status() eq $target->ST_MODIFIED.
+
+=item $target->is_unchanged()
+
+Shorthand for $target->get_status() eq $target->ST_UNCHANGED.
+
+=back
+
+=head1 CONSTANTS
+
+The following is a list of constants:
+
+=over 4
+
+=item FCM::Context::Make::Build->CTX_INPUT
+
+Alias of FCM::Context::Make::Build::Input.
+
+=item FCM::Context::Make::Build->CTX_SOURCE
+
+Alias of FCM::Context::Make::Build::Source.
+
+=item FCM::Context::Make::Build->ID_OF_CLASS
+
+The default value of the "id" attribute (of an instance), and the ID of the
+functional class. ("build")
+
+=item FCM::Context::Make::Build::Target->CT_BIN
+
+Target category, "bin", executable.
+
+=item FCM::Context::Make::Build::Target->CT_ETC
+
+Target category, "etc", data and misc file.
+
+=item FCM::Context::Make::Build::Target->CT_INCLUDE
+
+Target category, "include", include file.
+
+=item FCM::Context::Make::Build::Target->CT_LIB
+
+Target category, "lib", program library.
+
+=item FCM::Context::Make::Build::Target->CT_O
+
+Target category, "o", compiled object file.
+
+=item FCM::Context::Make::Build::Target->CT_SRC
+
+Target category, "src", generated source file.
+
+=item FCM::Context::Make::Build::Target->POLICY_CAPTURE
+
+Indicates that the dependency type is relevant to the target, and the build
+engine should stop floating the dependency target up the dependency tree.
+
+=item FCM::Context::Make::Build::Target->POLICY_FILTER
+
+Indicates that the dependency type is relevant to the target, and the build
+engine may float the dependency target up the dependency tree as well.
+
+=item FCM::Context::Make::Build::Target->POLICY_FILTER_IMMEDIATE
+
+Indicates that the dependency type is relevant to the target but only if the
+dependency target is an immediate dependency of this target, and the build
+engine may float the dependency target up the dependency tree as well.
+
+=item FCM::Context::Make::Build::Target->ST_FAILED
+
+Indicates that the build has failed to update the target.
+
+=item FCM::Context::Make::Build::Target->ST_MODIFIED
+
+Indicates that the target is out of date and has been modified by the build.
+
+=item FCM::Context::Make::Build::Target->ST_OOD
+
+Indicates that the target is out of date.
+
+=item FCM::Context::Make::Build::Target->ST_UNCHANGED
+
+Indicates that the target is up to date and unchanged by the build.
+
+=item FCM::Context::Make::Build::Target->ST_UNKNOWN
+
+Indicates an unknown target status.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make/Extract.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make/Extract.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make/Extract.pm	(revision 5095)
@@ -0,0 +1,494 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Make::Extract;
+use base qw{FCM::Class::HASH};
+
+use FCM::Context::Make;
+
+use constant {
+    CTX_PROJECT => 'FCM::Context::Make::Extract::Project',
+    CTX_SOURCE  => 'FCM::Context::Make::Extract::Source',
+    CTX_TARGET  => 'FCM::Context::Make::Extract::Target',
+    CTX_TREE    => 'FCM::Context::Make::Extract::Tree',
+    ID_OF_CLASS => 'extract',
+    MIRROR      => 1,
+};
+
+__PACKAGE__->class({
+    dest         => '$',
+    id           => {isa => '$', default => ID_OF_CLASS},
+    id_of_class  => {isa => '$', default => ID_OF_CLASS},
+    ns_list      => '@',
+    project_of   => '%',
+    status       => {isa => '$', default => FCM::Context::Make->ST_UNKNOWN},
+    target_of    => '%',
+    prop_of      => '%',
+});
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Make::Extract::Project;
+use base qw{FCM::Class::HASH};
+
+__PACKAGE__->class({
+    cache     => '$',
+    inherited => '$',
+    locator   => 'FCM::Context::Locator',
+    ns        => '$',
+    path_excl => '@',
+    path_incl => '@',
+    path_root => {isa => '$', default => q{}},
+    trees     => '@',
+});
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Make::Extract::Tree;
+use base qw{FCM::Class::HASH};
+
+__PACKAGE__->class({
+    cache     => '$',
+    inherited => '$',
+    key       => '$',
+    locator   => 'FCM::Context::Locator',
+    ns        => '$',
+    sources   => '@',
+});
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Make::Extract::Source;
+use base qw{FCM::Class::HASH};
+
+use constant {
+    ST_NORMAL    => 'ST_NORMAL',
+    ST_UNCHANGED => 'ST_UNCHANGED',
+    ST_MISSING   => 'ST_MISSING',
+};
+
+__PACKAGE__->class({
+    cache       => '$',
+    key_of_tree => '$',
+    locator     => 'FCM::Context::Locator',
+    ns          => '$',
+    ns_in_tree  => '$',
+    status      => {isa => '$', default => ST_NORMAL},
+});
+
+# Shorthand for $source->get_status() eq $source->ST_MISSING.
+sub is_missing {
+    $_[0]->get_status() eq ST_MISSING;
+}
+
+# Shorthand for $source->get_status() eq $source->ST_UNCHANGED.
+sub is_unchanged {
+    $_[0]->get_status() eq ST_UNCHANGED;
+}
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Make::Extract::Target;
+use base qw{FCM::Class::HASH};
+
+use constant {
+    ST_ADDED      => 'ST_ADDED',
+    ST_DELETED    => 'ST_DELETED',
+    ST_MERGED     => 'ST_MERGED',
+    ST_MODIFIED   => 'ST_MODIFIED',
+    ST_O_ADDED    => 'ST_O_ADDED',
+    ST_O_DELETED  => 'ST_O_DELETED',
+    ST_UNCHANGED  => 'ST_UNCHANGED',
+    ST_UNKNOWN    => 'ST_UNKNOWN',
+    can_be_source => 1,
+};
+
+__PACKAGE__->class({
+    dests            => '@',
+    ns               => '$',
+    path             => '$',
+    source_of        => '%',
+    status           => {isa => '$', default => ST_UNKNOWN},
+    status_of_source => {isa => '$', default => ST_UNKNOWN},
+});
+
+# Returns true if target has an OK status.
+sub is_ok {
+    my ($self) = @_;
+    my $status = $self->get_status();
+    grep {$_ eq $status}
+        (ST_ADDED, ST_MERGED, ST_MODIFIED, ST_O_ADDED, ST_UNCHANGED);
+}
+
+# Shorthand for $target->get_status() eq $target->ST_UNCHANGED.
+sub is_unchanged {
+    $_[0]->get_status() eq ST_UNCHANGED;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Context::Make::Extract
+
+=head1 SYNOPSIS
+
+    use FCM::Context::Make::Extract;
+    my $ctx = FCM::Context::Make::Extract->new();
+
+=head1 DESCRIPTION
+
+Provides a context object for the FCM extract system. All the classes described
+below are sub-classes of L<FCM::Class::HASH|FCM::Class::HASH>.
+
+=head1 OBJECTS
+
+=head2 FCM::Context::Make::Extract
+
+An instance of this class represents an extract. It has the following
+attributes:
+
+=over 4
+
+=item dest
+
+The destination of the extract.
+
+=item id
+
+The ID of the current context. (default="extract")
+
+=item id_of_class
+
+The class ID of the current context. (default="extract")
+
+=item ns_list
+
+An ARRAY of name-spaces of the projects to extract.
+
+=item project_of
+
+A HASH to map (key) the name-spaces of the projects in this extract to (value)
+their corresponding contexts.
+
+=item prop_of
+
+A HASH containing the named properties (i.e. options and settings of named
+external tools). Expects a value to be an instance of
+L<FCM::Context::Make::Share::Property|FCM::Context::Make::Share::Property>.
+
+=item status
+
+The status of the extract. See L<FCM::Context::Make|FCM::Context::Make> for the
+status constants.
+
+=item target_of
+
+A HASH to map (key) the name-spaces of the targets in this extract to (value)
+their corresponding contexts.
+
+=back
+
+=head2 FCM::Context::Make::Extract::Project
+
+An instance of this class represents a project in an extract. It has the
+following attributes:
+
+=over 4
+
+=item cache
+
+The file system location (cache) of this project.
+
+=item inherited
+
+This project is inherited?
+
+=item locator
+
+An instance of L<FCM::Context::Locator|FCM::Context::Locator> that represents
+the locator of this project.
+
+=item ns
+
+The name-space of this project.
+
+=item path_excl
+
+An ARRAY of patterns to match the names of the paths that will be excluded in
+this project.
+
+=item path_incl
+
+An ARRAY of patterns to match the names of the paths that will always be
+included in this project.
+
+=item path_root
+
+The relative path in a project tree for the root name-space. If this is
+specified, the system will extract only files under this path, and their
+name-spaces will be adjusted to be relative to this path.
+
+=item trees
+
+An ARRAY of the tree contexts in this project. By convention, the 0th element is
+the base tree.
+
+=back
+
+=head2 FCM::Context::Make::Extract::Tree
+
+An instance of this class represents a tree in a project. It has the following
+attributes:
+
+=over 4
+
+=item cache
+
+The file system location (cache) of this tree.
+
+=item inherited
+
+A flag to indicate whether this tree is provided by an inherited extract.
+
+=item key
+
+The key of this tree. By convention, the base tree is the 0th key.
+
+=item locator
+
+An instance of L<FCM::Context::Locator|FCM::Context::Locator> that represents
+the locator of this tree.
+
+=item ns
+
+The name-space of the project in which this tree belongs.
+
+=item sources
+
+An ARRAY of source file contexts provided by this tree.
+
+=back
+
+=head2 FCM::Context::Make::Extract::Source
+
+An instance of this class represents a source file provided by a project tree.
+It has the following attributes:
+
+=over 4
+
+=item cache
+
+The file system location (cache) of this source file.
+
+=item key_of_tree
+
+The key of the tree that provides this source file.
+
+=item locator
+
+An instance of L<FCM::Context::Locator|FCM::Context::Locator> that represents
+the locator of the source file.
+
+=item ns
+
+The full (mapped) name-space of the source file, (including the leading project
+name-space).
+
+=item ns_in_tree
+
+The original name-space of the source file, relative to its path in the tree.
+
+=item status
+
+The status of the source file. It can take the value of one of the
+FCM::Context::Make::Extract::Source->ST_* constants. See </CONSTANTS> for detail.
+
+=back
+
+In addition, an instance of FCM::Context::Make::Extract::Source has the
+following methods:
+
+=over 4
+
+=item $source->is_missing()
+
+Shorthand for $source->get_status() eq $source->ST_MISSING.
+
+=item $source->is_unchanged()
+
+Shorthand for $source->get_status() eq $source->ST_UNCHANGED.
+
+=back
+
+=head2 FCM::Context::Make::Extract::Target
+
+An instance of this class represents an extract target. It has the following
+attributes:
+
+=over 4
+
+=item dests
+
+An ARRAY containing the destination search path of this target. The first
+element is the path to the destination of the current extract, and the rest are
+destinations to inherited extracts.
+
+=item ns
+
+The full name-space of this target.
+
+=item path
+
+Returns the actual destination path of this target.
+
+=item source_of
+
+A HASH for mapping (key) the keys of the trees to (value) the corresponding
+contexts of the source files provided by the trees to this target.
+
+=item status
+
+The status of the target destination. It can take the value of one of the
+FCM::Context::Make::Extract::Target->ST_* constants. See </CONSTANTS> for detail.
+
+=item status_of_source
+
+The status of the target, with respect to its sources. It can take the value of
+one of the FCM::Context::Make::Extract::Target->ST_* constants. See </CONSTANTS>
+for detail.
+
+=back
+
+In addition, an instance of FCM::Context::Make::Extract::Target has the
+following methods:
+
+=over 4
+
+=item $target->can_be_source()
+
+Returns true if the destination status indicates that the target is usable as a
+source file of a subsequent a make (step).
+
+=item $target->is_ok()
+
+Returns true if the target has a OK destination status.
+
+=item $target->is_unchanged()
+
+Shorthand for $target->get_status() eq $target->ST_UNCHANGED.
+
+=back
+
+=head1 CONSTANTS
+
+The following is a list of constants:
+
+=over 4
+
+=item FCM::Context::Make::Extract->CTX_PROJECT
+
+An alias to FCM::Context::Make::Extract::Project.
+
+=item FCM::Context::Make::Extract->CTX_SOURCE
+
+An alias to FCM::Context::Make::Extract::Source.
+
+=item FCM::Context::Make::Extract->CTX_TARGET
+
+An alias to FCM::Context::Make::Extract::Target.
+
+=item FCM::Context::Make::Extract->CTX_TREE
+
+An alias to FCM::Context::Make::Extract::Tree.
+
+=item FCM::Context::Make::Extract->ID_OF_CLASS
+
+The default value of the "id" attribute (of an instance), and the ID of the
+functional class. ("extract")
+
+=item FCM::Context::Make::Extract->MIRROR
+
+A flag to tell the mirror sub-system that the targets of this context can be
+used as inputs sources to subsequent steps for the configuration file in the
+mirror destination.
+
+=item FCM::Context::Make::Extract::Source->ST_NORMAL
+
+Source status: normal.
+
+=item FCM::Context::Make::Extract::Source->ST_UNCHANGED
+
+Source status: source is unchanged (against base).
+
+=item FCM::Context::Make::Extract::Source->ST_MISSING
+
+Source status: source is a placeholder in a target. It does not actually exist
+in the source tree.
+
+=item FCM::Context::Make::Extract::Target->ST_ADDED
+
+As destination status: new file in the target destination. As source status:
+added by a source in a diff tree.
+
+=item FCM::Context::Make::Extract::Target->ST_DELETED
+
+As destination status: file removed from the target destination. As source
+status: target removed by a diff tree.
+
+=item FCM::Context::Make::Extract::Target->ST_MERGED
+
+As source status: modified by 2 or more diff trees.
+
+=item FCM::Context::Make::Extract::Target->ST_MODIFIED
+
+As destination status: target destination is modified. As source status:
+modified by 1 diff tree.
+
+=item FCM::Context::Make::Extract::Target->ST_O_ADDED
+
+As destination status: new file in the target destination, overriding a file in
+an inherited destination.
+
+=item FCM::Context::Make::Extract::Target->ST_O_DELETED
+
+As destination status: target destination should be removed, but there is still
+a file in an inherited destination.
+
+=item FCM::Context::Make::Extract::Target->ST_UNCHANGED
+
+As destination status: target destination is unchanged. As source status:
+unchanged by a diff tree.
+
+=item FCM::Context::Make::Extract::Target->ST_UNKNOWN
+
+Status is unknown.
+
+=back
+
+=head1 SEE ALSO
+
+L<FCM::System::Make::Extract|FCM::System::Make::Extract>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make/Mirror.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make/Mirror.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make/Mirror.pm	(revision 5095)
@@ -0,0 +1,119 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::Context::Make::Mirror;
+use base qw{FCM::Class::HASH};
+
+use FCM::Context::Make;
+
+use constant {ID_OF_CLASS => 'mirror'};
+
+__PACKAGE__->class({
+    dest           => '$',
+    id             => {isa => '$', default => ID_OF_CLASS},
+    id_of_class    => {isa => '$', default => ID_OF_CLASS},
+    prop_of        => '%',
+    status         => {isa => '$', default => FCM::Context::Make->ST_UNKNOWN},
+    target_logname => '$',
+    target_machine => '$',
+    target_path    => '$',
+});
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Context::Make::Mirror
+
+=head1 SYNOPSIS
+
+    use FCM::Context::Make::Mirror;
+    my $ctx = FCM::Context::Make::Mirror->new();
+    $ctx->set_dest_path($dest_path);
+    $ctx->set_source_path($source_path);
+    # ...
+
+=head1 DESCRIPTION
+
+Provides a context object for the mirror sub-system.
+
+=head1 ATTRIBUTES
+
+This class is based on L<FCM::Class::HASH|FCM::Class::HASH>. All attributes are
+accessible via $ctx->get_$attrib() and $ctx->set_$attrib($value) methods.
+
+=over 4
+
+=item dest
+
+The local working directory for the mirror sub-system.
+
+=item id
+
+The ID of the context. (default="mirror")
+
+=item id_of_class
+
+The class ID of the context. (default="mirror")
+
+=item prop_of
+
+A HASH containing the named properties (i.e. options and settings of named
+external tools). Expects a value to be an instance of
+L<FCM::Context::Make::Share::Property|FCM::Context::Make::Share::Property>.
+
+=item status
+
+The status of the context. See L<FCM::Context::Make|FCM::Context::Make> for the
+status constants.
+
+=item target_logname
+
+The logname part of the authority of the mirror destination.
+
+=item target_machine
+
+The machine part of the authority of the mirror destination.
+
+=item target_path
+
+The container path of the mirror destination (without the authority).
+
+=back
+
+=head1 CONSTANTS
+
+=over 4
+
+=item ID_OF_CLASS
+
+The default value of the "id" attribute (of an instance), and the ID of the
+functional class. ("mirror")
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make/Share/Property.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make/Share/Property.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Make/Share/Property.pm	(revision 5095)
@@ -0,0 +1,138 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::Context::Make::Share::Property;
+use base qw{FCM::Class::HASH};
+
+use constant {
+    CTX_VALUE  => 'FCM::Context::Make::Share::Property::Value',
+    NS_OF_ROOT => q{},
+};
+
+__PACKAGE__->class({ctx_of => '%', id => '$'});
+
+sub get_ctx {
+    $_[0]->get_ctx_of(NS_OF_ROOT);
+}
+
+sub set_ctx {
+    $_[0]->get_ctx_of()->{$_[0]->NS_OF_ROOT} = $_[1];
+}
+
+# ------------------------------------------------------------------------------
+package FCM::Context::Make::Share::Property::Value;
+use base qw{FCM::Class::HASH};
+
+__PACKAGE__->class({inherited => '$', value => '$'});
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Context::Make::Share::Property
+
+=head1 SYNOPSIS
+
+    use FCM::Context::Make::Share::Property;
+    $prop = FCM::Context::Make::Share::Property->new(\%attrib);
+
+=head1 DESCRIPTION
+
+Provides a context object to store the property of a named shell command.
+
+=head1 OBJECTS
+
+The classes described below are all sub-classes of
+L<FCM::Class::HASH|FCM::Class::HASH>.
+
+=head2 FCM::Context::Make::Share::Property
+
+This class represents a property. It has the following attributes:
+
+=over 4
+
+=item ctx_of
+
+A HASH to map (keys) the name-spaces to (values) the contexts of this property.
+Expects each context to be an instance of
+L</FCM::Context::Make::Share::Property::Value>.
+
+The context of a simple property is stored in the root (i.e. the empty string)
+name-space.
+
+=item id
+
+The ID of this property.
+
+=back
+
+An instance of FCM::Context::Make::Share::Property has 2 additional methods:
+
+=over 4
+
+=item $instance->get_ctx()
+
+Shorthand for:
+
+    $instance->get_ctx_of(q{}).
+
+=item $instance->set_ctx($ctx)
+
+Shorthand for:
+
+    $instance->get_ctx_of()->{q{}} = $ctx.
+
+=back
+
+=head2 FCM::Context::Make::Share::Property::Value
+
+This class represents a property value (associated with a name-space). It has
+the following attributes:
+
+=over 4
+
+=item inherited
+
+A flag, if true, indicates that this value is inherited.
+
+=item value
+
+The value.
+
+=back
+
+=head1 CONSTANTS
+
+=over 4
+
+=item FCM::Context::Make::Share::Property->NS_OF_ROOT
+
+The root name-space, an empty string.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Task.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Task.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Context/Task.pm	(revision 5095)
@@ -0,0 +1,105 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::Context::Task;
+use base qw{FCM::Class::HASH};
+
+use constant {
+    ST_FAILED  => 'ST_FAILED',
+    ST_OK      => 'ST_OK',
+    ST_WORKING => 'ST_WORKING',
+};
+
+__PACKAGE__->class({
+    ctx      => {},
+    error    => {},
+    id       => '$',
+    elapse   => {isa => '$', default => 0},
+    state    => {isa => '$', default => ST_WORKING},
+});
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Context::Task
+
+=head1 SYNOPSIS
+
+    use FCM::Context::Task;
+    my $task = FCM::Context::Task->new(\%attrib);
+
+=head1 DESCRIPTION
+
+An instance of this class represents the generic context for a task for the
+L<FCM::Util->task_runner()|FCM::Util>. This class is a sub-class of
+L<FCM::Class::HASH|FCM::Class::HASH>.
+
+=head1 ATTRIBUTES
+
+=over 4
+
+=item ctx
+
+The specific context of the task, such as the inputs and the outputs.
+
+=item error
+
+If the task failed, the error/exception will be returned in this attribute.
+
+=item id
+
+The ID of the task.
+
+=item elapse
+
+The amount of time (in seconds) taken to run the task.
+
+=item state
+
+The state of the task. See L</CONSTANTS> for possible variables.
+
+=back
+
+=head1 CONSTANTS
+
+=over 4
+
+=item FCM::Context::Task->ST_FAILED
+
+A status to indicate that the task has failed.
+
+=item FCM::Context::Task->ST_OK
+
+A status to indicate that the task is completed successfully.
+
+=item FCM::Context::Task->ST_WORKING
+
+A status to indicate that the task is bing worked on.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Exception.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Exception.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Exception.pm	(revision 5095)
@@ -0,0 +1,113 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Exception;
+
+use Data::Dumper qw{Dumper};
+use Scalar::Util qw{blessed};
+use overload (q{""} => \&Dumper);
+
+use constant {
+    DEFAULT => 'DEFAULT',
+};
+
+# Returns true if $e is a blessed instance of $class.
+sub caught {
+    my ($class, $e) = @_;
+    return (blessed($e) && $e->isa($class));
+}
+
+# Throws the exception.
+sub throw {
+    my ($class, $code, $ctx, $e) = @_;
+    if (defined($e) && !ref($e) && $e =~ qr{\A\s*\z}msx) {
+        $e = undef;
+    }
+    die(bless({code => $code, ctx => $ctx, exception => $e}, $class));
+}
+
+# Attribute accessors.
+for my $name (qw{code ctx exception}) {
+    no strict qw{refs};
+    *{"get_$name"} = sub {$_[0]->{$name}};
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Exception
+
+=head1 SYNOPSIS
+
+    use FCM::Exception;
+    my $E = 'FCM::Exception';
+    eval {
+        # ...
+        if ($some_error_condition) {
+            return $E->throw($code, $ctx);
+        }
+        # ...
+    };
+    if (my $e = $@) {
+        if ($E->caught($e)) {
+            # ...
+        }
+    }
+
+=head1 DESCRIPTION
+
+Exception associated with an FCM operation.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->caught($e)
+
+Returns true if $e is a blessed object of $class.
+
+=item $class->throw($code,$ctx,$e)
+
+Creates an instance and die() with it.
+
+=item $e->get_code()
+
+Returns the code associated with this exception.
+
+=item $e->get_ctx()
+
+Returns the context associated with this exception.
+
+=item $e->get_exception()
+
+Returns the exception that generates this exception.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System.pm	(revision 5095)
@@ -0,0 +1,286 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+
+package FCM::System;
+use base qw{FCM::Class::CODE};
+
+use FCM::Util;
+use Scalar::Util qw{reftype};
+
+# Alias
+our $S;
+
+# The (keys) named actions of this class and (values) their implementations.
+our %ACTION_OF = (
+    browse               => _func('misc', sub {$S->browse(@_)}),
+    build                => _func('old' , sub {$S->build(@_)}),
+    config_compare       => _func('old' , sub {$S->config_compare(@_)}),
+    config_parse         => _func('misc', sub {$S->config_parse(@_)}),
+    cm_branch_create     => _func('cm'  , sub {$S->cm_branch_create(@_)}),
+    cm_branch_delete     => _func('cm'  , sub {$S->cm_branch_delete(@_)}),
+    cm_branch_diff       => _func('cm'  , sub {$S->cm_branch_diff(@_)}),
+    cm_branch_info       => _func('cm'  , sub {$S->cm_branch_info(@_)}),
+    cm_branch_list       => _func('cm'  , sub {$S->cm_branch_list(@_)}),
+    cm_commit            => _func('cm'  , sub {$S->cm_commit(@_)}),
+    cm_checkout          => _func('cm'  , sub {$S->cm_checkout(@_)}),
+    cm_check_missing     => _func('cm'  , sub {$S->cm_check_missing(@_)}),
+    cm_check_unknown     => _func('cm'  , sub {$S->cm_check_unknown(@_)}),
+    cm_diff              => _func('cm'  , sub {$S->cm_diff(@_)}),
+    cm_loc_layout        => _func('cm'  , sub {$S->cm_loc_layout(@_)}),
+    cm_merge             => _func('cm'  , sub {$S->cm_merge(@_)}),
+    cm_mkpatch           => _func('cm'  , sub {$S->cm_mkpatch(@_)}),
+    cm_project_create    => _func('cm'  , sub {$S->cm_project_create(@_)}),
+    cm_resolve_conflicts => _func('cm'  , sub {$S->cm_resolve_conflicts(@_)}),
+    cm_switch            => _func('cm'  , sub {$S->cm_switch(@_)}),
+    cm_update            => _func('cm'  , sub {$S->cm_update(@_)}),
+    export_items         => _func('misc', sub {$S->export_items(@_)}),
+    extract              => _func('old' , sub {$S->extract(@_)}),
+    keyword_find         => _func('misc', sub {$S->keyword_find(@_)}),
+    make                 => _func('make', sub {$S->main(@_)}),
+    svn                  => _func('cm'  , sub {$S->svn(@_)}),
+    util                 => sub {$_[0]->{util}},
+);
+# The (keys) named system and their implementation classes.
+our %SYSTEM_CLASS_OF = (
+    cm   => 'FCM::System::CM',
+    old  => 'FCM::System::Old',
+    make => 'FCM::System::Make',
+    misc => 'FCM::System::Misc',
+);
+
+# Creates the class.
+__PACKAGE__->class(
+    {   gui             => '$',
+        system_class_of => {isa => '%', default => {%SYSTEM_CLASS_OF}},
+        system_of       => '%',
+        util            => '&',
+    },
+    {init => \&_init, action_of => {%ACTION_OF}},
+);
+
+# Initialises attributes.
+sub _init {
+    my $attrib_ref = shift();
+    $attrib_ref->{util} = FCM::Util->new();
+}
+
+# Generates main functions.
+sub _func  {
+    my ($name, $code_ref) = @_;
+    sub {
+        my ($attrib_ref, @args) = @_;
+        if (!defined($attrib_ref->{system_of}{$name})) {
+            my $class_name = $attrib_ref->{system_class_of}{$name};
+            $attrib_ref->{util}->class_load($class_name);
+            $attrib_ref->{system_of}{$name} = $class_name->new({
+                gui  => $attrib_ref->{gui},
+                util => $attrib_ref->{util},
+            });
+        }
+        local($S) = $attrib_ref->{system_of}{$name};
+        $code_ref->(@args);
+    };
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System
+
+=head1 SYNOPSIS
+
+    use FCM::System;
+    $fcm = FCM::System->new();
+    # ...
+    $fcm->make(\%option, @args);
+
+=head1 DESCRIPTION
+
+Provides a top level interface to access the functionalities of the FCM system.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Returns a new instance. It also initialises the utility and sub-system classes.
+The %attrib hash can be used configure the behaviour of the instance:
+
+=over 4
+
+=item event
+
+A CODE to handle event.
+
+=item gui
+
+The GUI geometry of "fcm gui-internal".
+
+=item system_class_of
+
+A HASH to map (keys) sub-system names to (values) their implementation classes.
+See %FCM::System::SYSTEM_CLASS_OF.
+
+=item system_of
+
+A HASH to map (keys) sub-system names to (values) their implementation instances.
+
+=item util
+
+An instance of L<FCM::Util|FCM::Util>.
+
+=back
+
+=item $fcm->browse(\%option,@args)
+
+Invokes a browser to browse the sources in @args.
+
+=item $fcm->build(\%option,@args)
+
+(Obsolete) Invokes the FCM 1 build system.
+
+=item $fcm->config_compare(\%option,@args)
+
+(Obsolete) Compares 2 FCM 1 extract configuration files.
+
+=item $fcm->config_parse(\%option,@args)
+
+Parses a configuration file.
+
+=item $fcm->cm_branch_create(\%option,@args)
+
+Creates of a branch in a project in a Subversion repository with a standard FCM
+layout.
+
+=item $fcm->cm_branch_delete(\%option,@args)
+
+Deletes of a branch in a project in a Subversion repository with a standard FCM
+layout.
+
+=item $fcm->cm_branch_diff(\%option,@args)
+
+Displays the changes between a branch and its parent in a project in a
+Subversion repository with a standard FCM layout.
+
+=item $fcm->cm_branch_info(\%option,@args)
+
+Displays information of a branch in a project in a Subversion repository with a
+standard FCM layout.
+
+=item $fcm->cm_branch_list(\%option,@args)
+
+Lists branches in a project in a Subversion repository with a standard FCM
+layout.
+
+=item $fcm->cm_commit(\%option,@args)
+
+Wraps C<svn commit>.
+
+=item $fcm->cm_checkout(\%option,@args)
+
+Wraps C<svn checkout>.
+
+=item $fcm->cm_check_missing(\%option,@args)
+
+Checks for missing status in a Subversion working copy.
+
+=item $fcm->cm_check_unknown(\%option,@args)
+
+Checks for unknown status in a Subversion working copy.
+
+=item $fcm->cm_diff(\%option,@args)
+
+Wraps C<svn diff>.
+
+=item $fcm->cm_loc_layout(\%option,@args)
+
+Parse and print layout information of each target in @args.
+
+=item $fcm->cm_merge(\%option,@args)
+
+Wraps C<svn merge>.
+
+=item $fcm->cm_mkpatch(\%option,@args)
+
+Creates FCM patches.
+
+=item $fcm->cm_project_create(\%option,@args)
+
+Create a new project in a Subversion repository.
+
+=item $fcm->cm_resolve_conflicts(\%option,@args)
+
+Invokes a graphic merge tool to resolve conflicts.
+
+=item $fcm->cm_switch(\%option,@args)
+
+Wraps C<svn switch>.
+
+=item $fcm->cm_update(\%option,@args)
+
+Wraps C<svn update>.
+
+=item $fcm->export_items(\%option,@args)
+
+Exports directories as versioned items in a branch of a project in a Subversion
+repository with the standard FCM layout.
+
+=item $fcm->extract(\%option,@args)
+
+(Obsolete) Invokes the FCM 1 extract system.
+
+=item $fcm->keyword_find(\%option,@args)
+
+If @args is empty, search for all known FCM location keyword entries. Otherwise,
+search for FCM location keyword entries matching the locations specified in
+@args.
+
+=item $fcm->make(\%option,@args)
+
+Invokes the FCM make system.
+
+=item $fcm->svn(\%option,@args)
+
+Invokes C<svn> with @args. %option is ignored.
+
+=item $fcm->util()
+
+Returns the L<FCM::Util|FCM::Util> object.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=head2 FCM::System::Exception
+
+This exception is a sub-class of L<FCM::Exception|FCM::Exception> and is thrown
+by methods of this class on error.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM.pm	(revision 5095)
@@ -0,0 +1,715 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::CM;
+use base qw{FCM::Class::CODE};
+
+use Cwd qw{cwd};
+use FCM1::Cm;
+use FCM1::Interactive;
+use FCM::Context::Event;
+use FCM::Context::Locator;
+use FCM::System::CM::CommitMessage;
+use FCM::System::CM::Prompt;
+use FCM::System::CM::ResolveConflicts qw{_cm_resolve_conflicts};
+use FCM::System::CM::SVN;
+use FCM::System::Exception;
+use FCM::Util::Exception;
+use File::Spec::Functions qw{catfile};
+use List::Util qw{first};
+use Storable qw{dclone};
+
+# The (keys) named actions of this class and (values) their implementations.
+our %ACTION_OF = (
+    cm_branch_create     => \&_cm_branch_create,
+    cm_branch_delete     => _fcm1_func(\&FCM1::Cm::cm_branch_delete),
+    cm_branch_diff       => _fcm1_func(\&FCM1::Cm::cm_branch_diff),
+    cm_branch_info       => _fcm1_func(\&FCM1::Cm::cm_branch_info),
+    cm_branch_list       => \&_cm_branch_list,
+    cm_commit            => _fcm1_func(\&FCM1::Cm::cm_commit),
+    cm_checkout          => \&_cm_checkout,
+    cm_check_missing     => _fcm1_func(
+        \&FCM1::Cm::cm_check_missing,
+        _opt_mod_st_check_handler_func('WC_STATUS_PATH'),
+    ),
+    cm_check_unknown     => _fcm1_func(
+        \&FCM1::Cm::cm_check_unknown,
+        _opt_mod_st_check_handler_func('WC_STATUS_PATH'),
+    ),
+    cm_diff              => \&_cm_diff,
+    cm_loc_layout        => \&_cm_loc_layout,
+    cm_merge             => _fcm1_func(\&FCM1::Cm::cm_merge),
+    cm_mkpatch           => _fcm1_func(\&FCM1::Cm::cm_mkpatch),
+    cm_project_create    => \&_cm_project_create,
+    cm_resolve_conflicts => \&_cm_resolve_conflicts,
+    cm_switch            => _fcm1_func(
+        \&FCM1::Cm::cm_switch, _opt_mod_st_check_handler_func('WC_STATUS'),
+    ),
+    cm_update            => _fcm1_func(
+        \&FCM1::Cm::cm_update, _opt_mod_st_check_handler_func('WC_STATUS'),
+    ),
+    svn                  => \&_svn,
+);
+
+# Alias
+my $E = 'FCM::System::Exception';
+
+# Creates the class.
+__PACKAGE__->class(
+    {   commit_message_util => '&',
+        gui                 => '$',
+        prompt              => '&',
+        svn                 => '&',
+        util                => '&',
+    },
+    {init => \&_init, action_of => \%ACTION_OF},
+);
+
+sub _init {
+    my ($attrib_ref) = @_;
+    if (!defined(FCM1::Keyword::get_util())) {
+        FCM1::Keyword::set_util($attrib_ref->{util});
+    }
+    if ($attrib_ref->{'gui'}) {
+        FCM1::Interactive::set_impl(
+            'FCM1::Interactive::InputGetter::GUI',
+            {geometry => $attrib_ref->{gui}},
+        );
+    }
+    $attrib_ref->{prompt} = FCM::System::CM::Prompt->new({
+        gui => $attrib_ref->{gui}, util => $attrib_ref->{util},
+    });
+    $attrib_ref->{commit_message_util} = FCM::System::CM::CommitMessage->new({
+        gui  => $attrib_ref->{gui},
+        util => $attrib_ref->{util},
+    });
+    $attrib_ref->{svn} = FCM::System::CM::SVN->new({util => $attrib_ref->{util}});
+    FCM1::Cm::set_util($attrib_ref->{util});
+    FCM1::Cm::set_commit_message_util($attrib_ref->{commit_message_util});
+    FCM1::Cm::set_svn_util($attrib_ref->{svn});
+}
+
+# Create a branch in a project.
+sub _cm_branch_create {
+    my ($attrib_ref, $option_ref, @args) = @_;
+    _parse_args($attrib_ref, $option_ref, \@args);
+    my ($name, $source) = @args;
+    # Check branch name
+    if (!$name || $name !~ qr{\A[\w\.\-/]+\z}msx) {
+        return $E->throw($E->CM_BRANCH_NAME, $name ? $name : q{});
+    }
+    # Determine ticket list with name
+    if (!$option_ref->{ticket} && $name =~ qr{\A[1-9]\d*([_\-][1-9]\d*)*\z}msx) {
+        $option_ref->{ticket} = [split(qr{[_\-]}msx, $name)];
+    }
+    # Check source
+    $source ||= cwd() . '@HEAD';
+    my $layout = $attrib_ref->{svn}->get_layout($source);
+    my $root = $layout->get_root();
+    my $source_rev = $layout->get_peg_rev();
+    my $project = $layout->get_project();
+    my $source_branch = $layout->get_branch();
+    if (!defined($project)) {
+        return $E->throw($E->CM_BRANCH_SOURCE, $source);
+    }
+    my @project_paths = split(qr{/}msx, $project);
+
+    # Determine whether to create a branch of a branch
+    if (!$option_ref->{'branch-of-branch'} || !$source_branch) {
+        $source_branch = 'trunk';
+    }
+    $source = join('/', $root, @project_paths, $source_branch)
+        . '@' . $source_rev;
+    my $source_commit_rev
+        = $attrib_ref->{svn}->get_info($source)->[0]->{'commit:revision'};
+    $source = join('/', $root, @project_paths, $source_branch)
+        . '@' . $source_commit_rev;
+    $attrib_ref->{util}->event(
+        FCM::Context::Event->CM_BRANCH_CREATE_SOURCE, $source, $source_rev,
+    );
+
+    # Handle multiple tickets
+    $option_ref->{ticket} ||= [];
+    $option_ref->{ticket} = [
+        sort
+            {$a <=> $b}
+        map
+            {s{\A#}{}msx; $_}
+        split(qr{,}msx, join(q{,}, @{$option_ref->{ticket}}))
+    ];
+
+    # Determine the sub-directory names of the branch
+    # FIXME: hard coded legacy!
+    my %layout_config = %{$layout->get_config()};
+    my @names;
+    if ($layout_config{'template-branch'}) {
+        my $template = $layout_config{'template-branch'};
+        if (    index($template, '{category}') >= 0
+            ||  index($template, '{owner}') >= 0
+        ) {
+            $option_ref->{type} ||= 'dev::user';
+            $option_ref->{type} = lc($option_ref->{type});
+            $option_ref->{type}
+                = $option_ref->{type} eq 'user'   ? 'dev::user'
+                : $option_ref->{type} eq 'share'  ? 'dev::share'
+                : $option_ref->{type} eq 'config' ? 'pkg::config'
+                : $option_ref->{type} eq 'rel'    ? 'pkg::rel'
+                : $option_ref->{type} eq 'dev'    ? 'dev::user'
+                : $option_ref->{type} eq 'test'   ? 'test::user'
+                : $option_ref->{type} eq 'pkg'    ? 'pkg::user'
+                :                                   $option_ref->{type}
+                ;
+            if (!grep {$option_ref->{type} eq $_} qw{
+                dev::share dev::user test::share test::user
+                pkg::config pkg::rel  pkg::share  pkg::user
+            }) {
+                return $E->throw($E->CM_OPT_ARG, ['type', $option_ref->{type}]);
+            }
+            my %set = map {$_ => 1} split('::', $option_ref->{type});
+            if (index($template, '{category}') >= 0) {
+                my $index = index($template, '{category}');
+                my $category = first {exists($set{$_})} qw{dev test pkg};
+                substr($template, $index, length('{category}'), $category);
+            }
+            if (index($template, '{owner}') >= 0) {
+                my $index = index($template, '{owner}');
+                my $owner = exists($set{user})
+                    ? $attrib_ref->{svn}->get_username($root)
+                    : first {exists($set{lc($_)})} qw{Share Config Rel};
+                substr($template, $index, length('{owner}'), $owner);
+            }
+        }
+        if (index($template, '{name_prefix}') >= 0) {
+            my $index = index($template, '{name_prefix}');
+            # Check revision flag is valid
+            $option_ref->{'rev-flag'} ||= 'normal';
+            $option_ref->{'rev-flag'} = lc($option_ref->{'rev-flag'});
+            if (!grep {$_ eq $option_ref->{'rev-flag'}} qw{normal number none}) {
+                return $E->throw(
+                    $E->CM_OPT_ARG, ['rev-flag', $option_ref->{'rev-flag'}]);
+            }
+            my $name_prefix = q{};
+            if ($option_ref->{'rev-flag'} ne 'none') {
+                $name_prefix = 'r' . $source_commit_rev;
+                if ($option_ref->{'rev-flag'} eq 'normal') {
+                    # Attempt to replace revision number with a keyword
+                    my $locator = FCM::Context::Locator->new($source);
+                    my $as_keyword = $attrib_ref->{util}->loc_as_keyword($locator);
+                    my ($u, $r) = $attrib_ref->{svn}->split_by_peg($as_keyword);
+                    if ($source_commit_rev ne $r) {
+                        $name_prefix = $r;
+                    }
+                }
+
+                # Add an underscore
+                $name_prefix .= '_';
+            }
+            substr($template, $index, length('{name_prefix}'), $name_prefix);
+        }
+        if (index($template, '{name}') >= 0) {
+            my $index = index($template, '{name}');
+            substr($template, $index, length('{name}'), $name);
+        }
+        push(@names, split(qr{/+}msx, $template));
+    }
+    else {
+        push(@names, split(qr{/+}msx, $name));
+    }
+    if ($layout_config{'depth-branch'} != scalar(@names)) {
+        return $E->throw($E->CM_BRANCH_NAME, join('/', @names));
+    }
+    if ($layout_config{'dir-branch'}) {
+        unshift(@names, $layout_config{'dir-branch'});
+    }
+    # Check whether the branch already exists
+    my $target = join('/', $root, @project_paths, @names);
+    my $target_url = eval {$attrib_ref->{svn}->get_info($target)->[0]->{url}};
+    $@ = undef;
+    if ($target_url) {
+        return $E->throw($E->CM_ALREADY_EXIST, $target_url);
+    }
+
+    # Message for the commit log
+    my @tickets = @{$option_ref->{ticket}};
+    my @message = sprintf('%sCreated %s from %s@%d.' . "\n",
+        (@tickets ? join(q{,}, map {'#' . $_} @tickets) . q{: } : q{}),
+        join('/', q{}, @project_paths, @names),
+        join('/', q{}, @project_paths, $source_branch), $source_commit_rev,
+    );
+
+    # Create a temporary file for the commit log message
+    my $commit_message_ctx = $attrib_ref->{commit_message_util}->ctx();
+    $commit_message_ctx->set_auto_part(join(q{}, @message));
+    $commit_message_ctx->set_info_part(sprintf("%s    %s\n", 'A', $target));
+    if (!$option_ref->{'non-interactive'}) {
+        $attrib_ref->{commit_message_util}->edit($commit_message_ctx);
+    }
+    $attrib_ref->{commit_message_util}->notify($commit_message_ctx);
+    my $temp_handle
+        = $attrib_ref->{commit_message_util}->temp($commit_message_ctx);
+
+    # Check with the user to see if he/she wants to go ahead
+    if (    !$option_ref->{'non-interactive'}
+        &&  !$attrib_ref->{prompt}->question('BRANCH_CREATE')
+    ) {
+        return;
+    }
+
+    # Create the branch
+    $attrib_ref->{svn}->call(
+        'copy',
+        '--file', $temp_handle->filename(),
+        '--parents',
+        ($option_ref->{'svn-non-interactive'} ? '--non-interactive' : ()),
+        (   defined($option_ref->{'password'})
+            ? ('--password', $option_ref->{'password'}) : ()
+        ),
+        $source,
+        $target,
+    );
+    $attrib_ref->{util}->event(FCM::Context::Event->CM_CREATE_TARGET, $target);
+
+    # Switch working copy to point to newly created branch
+    if ($option_ref->{'switch'}) {
+        $ACTION_OF{'cm_switch'}->($attrib_ref, $option_ref, $target);
+    }
+
+    $target;
+}
+
+# Filter lists branches in projects.
+sub _cm_branch_list {
+    my ($attrib_ref, $option_ref, @args) = @_;
+    _parse_args($attrib_ref, $option_ref, \@args);
+    my $used_default_arg;
+    if (!@args) {
+        @args = cwd() . '@HEAD';
+        $used_default_arg = 1;
+    }
+    my %common_patterns_at;
+    if ($option_ref->{'only'} && @{$option_ref->{'only'}}) {
+        for (@{$option_ref->{'only'}}) {
+            my ($depth, $pattern) = split(qr{:}msx, $_, 2);
+            $common_patterns_at{$depth} ||= [];
+            push(@{$common_patterns_at{$depth}}, $pattern);
+        }
+    }
+    my $UTIL = $attrib_ref->{'util'};
+    ARG:
+    for my $arg (@args) {
+        my %patterns_at = %{dclone(\%common_patterns_at)};
+        my %info = eval {%{$attrib_ref->{svn}->get_info($arg)->[0]}};
+        if ($@) {
+            if ($used_default_arg) {
+                # Can't complain about a bad arg if we put it there.
+                return $E->throw($E->SHELL, $@->{ctx}, $@->{ctx}->{e});
+            }
+            return $E->throw($E->CM_ARG, $arg);
+        }
+        my $url = $info{'url'} . '@' . $info{'revision'};
+        my $layout = $attrib_ref->{svn}->get_layout($url);
+        my $root = $layout->get_root();
+        my $rev = $layout->get_peg_rev();
+        my $project = $layout->get_project();
+        if (!defined($project)) {
+            next ARG;
+        }
+        my $url_project = $root . ($project ? '/' . $project : q{});
+        my %layout_config = %{$layout->get_config()};
+        if ($layout_config{'level-owner-branch'} && !$option_ref->{'show-all'}) {
+            my $level = $layout_config{'level-owner-branch'};
+            if ($option_ref->{'user'} && @{$option_ref->{'user'}}) {
+                $patterns_at{$level} = [
+                    map {'^' . $_ . '$'}
+                    map {split(qr{[,:]}msx, $_)}
+                    @{$option_ref->{'user'}}
+                ];
+            }
+            elsif (!%patterns_at) {
+                my $owner = $attrib_ref->{svn}->get_username($root);
+                $patterns_at{$level} = ['^' . $owner . '$'];
+            }
+        }
+        my $url0 = $url_project;
+        if ($layout_config{'dir-branch'}) {
+            $url0 .= '/' . $layout_config{'dir-branch'};
+        }
+        else {
+            for my $key (qw{trunk tag}) {
+                if ($layout_config{"dir-$key"}) {
+                    $patterns_at{1} ||= [];
+                    push(
+                        @{$patterns_at{1}},
+                        '^(?!' . $layout_config{"dir-$key"} .  '$)',
+                    );
+                }
+            }
+        }
+        my @branches = $attrib_ref->{svn}->get_list(
+            $url0 . '@' . $rev,
+            sub {
+                my ($this_url, $this_name, $is_dir, $depth) = @_;
+                if (    exists($patterns_at{$depth})
+                    &&  !grep {$this_name =~ /$_/} @{$patterns_at{$depth}}
+                ) {
+                    return (0, 0);
+                }
+                my $can_return = $depth >= $layout_config{'depth-branch'};
+                ($can_return, ($is_dir && !$can_return));
+            },
+        );
+        if ($option_ref->{'url'}) {
+            $UTIL->event(
+                FCM::Context::Event->CM_BRANCH_LIST,
+                $url_project . '@' . $rev, @branches,
+            );
+        }
+        else {
+            $UTIL->event(
+                FCM::Context::Event->CM_BRANCH_LIST,
+                map {$UTIL->loc_as_keyword(FCM::Context::Locator->new($_))}
+                    ($url_project . '@' . $rev, @branches),
+            );
+        }
+    }
+}
+
+# Wraps "svn checkout".
+sub _cm_checkout {
+    my ($attrib_ref, $option_ref, @args) = @_;
+    _parse_args($attrib_ref, $option_ref, \@args);
+    my $target = @args && !$attrib_ref->{util}->uri_match($args[-1])
+        ? $args[-1] : cwd();
+    my $info_entry = eval {$attrib_ref->{svn}->get_info($target)->[0]};
+    if ($@) {
+        $@ = undef; # OK, not a working copy
+    }
+    elsif (grep {index($_, 'wc-info:') == 0} keys(%{$info_entry})) {
+        return $E->throw($E->CM_CHECKOUT, [$target, $info_entry->{url}]);
+    }
+    $attrib_ref->{svn}->call('checkout', @args);
+}
+
+# Wraps "svn diff".
+sub _cm_diff {
+    my ($attrib_ref, $option_ref, @args) = @_;
+    _parse_args($attrib_ref, $option_ref, \@args);
+    local(%ENV) = %ENV;
+    $ENV{FCM_GRAPHIC_DIFF}
+        ||= $attrib_ref->{util}->external_cfg_get('graphic-diff');
+    $attrib_ref->{svn}->call('diff', @args);
+}
+
+# Parse and print layout information of each target in @args.
+sub _cm_loc_layout {
+    my ($attrib_ref, $option_ref, @args) = @_;
+    _parse_args($attrib_ref, $option_ref, \@args);
+    if (!@args) {
+        @args = qw{.};
+    }
+    my $OUT = sub {
+        $attrib_ref->{util}->event(FCM::Context::Event->OUT, @_);
+    };
+    my $not_first;
+    for my $arg (@args) {
+        if ($not_first) {
+            $OUT->("\n");
+        }
+        $not_first = 1;
+        $OUT->("target: $arg\n");
+        my $layout = $attrib_ref->{svn}->get_layout($arg);
+        $OUT->($layout->as_string());
+    }
+}
+
+# Create a new project in a repository.
+sub _cm_project_create {
+    my ($attrib_ref, $option_ref, @args) = @_;
+    _parse_args($attrib_ref, $option_ref, \@args);
+    my ($name, $root_arg) = @args;
+    # Check project name
+    if (!$name || $name !~ qr{\A[\w\.\-/]+\z}msx) {
+        return $E->throw($E->CM_PROJECT_NAME, $name);
+    }
+    # Check root
+    if (!$root_arg) {
+        return $E->throw($E->CM_REPOSITORY, q{});
+    }
+    my $layout = $attrib_ref->{svn}->get_layout($root_arg);
+    my $root = $layout->get_root();
+    if (!$root) {
+        return $E->throw($E->CM_REPOSITORY, $root_arg);
+    }
+
+    # Check whether the depth of the project name is valid
+    my %layout_config = %{$layout->get_config()};
+    my @names = split(qr{/+}msx, $name);
+    my $depth_expected = $layout_config{'depth-project'};
+    if (defined($depth_expected) && $depth_expected != scalar(@names)) {
+        return $E->throw($E->CM_PROJECT_NAME, join('/', @names));
+    }
+    # Check whether the project (trunk) already exists
+    my $target = join('/', $root, @names, $layout_config{'dir-trunk'});
+    my $target_url = eval {$attrib_ref->{svn}->get_info($target)->[0]->{url}};
+    $@ = undef;
+    if ($target_url) {
+        return $E->throw($E->CM_ALREADY_EXIST, $target_url);
+    }
+
+    # Message for the commit log
+    my @message = sprintf("%s: new project.\n", join('/', @names));
+
+    # Create a temporary file for the commit log message
+    my $commit_message_ctx = $attrib_ref->{commit_message_util}->ctx();
+    $commit_message_ctx->set_auto_part(join(q{}, @message));
+    $commit_message_ctx->set_info_part(sprintf("%s    %s\n", 'A', $target));
+    if (!$option_ref->{'non-interactive'}) {
+        $attrib_ref->{commit_message_util}->edit($commit_message_ctx);
+    }
+    $attrib_ref->{commit_message_util}->notify($commit_message_ctx);
+    my $temp_handle
+        = $attrib_ref->{commit_message_util}->temp($commit_message_ctx);
+
+    # Check with the user to see if he/she wants to go ahead
+    if (    !$option_ref->{'non-interactive'}
+        &&  !$attrib_ref->{prompt}->question('PROJECT_CREATE')
+    ) {
+        return;
+    }
+
+    # Create the branch
+    $attrib_ref->{svn}->call(
+        'mkdir',
+        '--file', $temp_handle->filename(),
+        '--parents',
+        ($option_ref->{'svn-non-interactive'} ? '--non-interactive' : ()),
+        (   defined($option_ref->{'password'})
+            ? ('--password', $option_ref->{'password'}) : ()
+        ),
+        $target,
+    );
+    $attrib_ref->{util}->event(FCM::Context::Event->CM_CREATE_TARGET, $target);
+
+    $target;
+}
+
+# Returns a simple wrapper to FCM 1 FCM1::Cm functions.
+sub _fcm1_func {
+    my ($action_ref, $opt_mod_ref) = @_;
+    $opt_mod_ref ||= sub {};
+    sub {
+        my ($attrib_ref, $option_ref, @args) = @_;
+        _parse_args($attrib_ref, $option_ref, \@args);
+        local(@ARGV) = @args;
+        $opt_mod_ref->($option_ref);
+        eval {$action_ref->($option_ref, @args)};
+        if ($@) {
+            if (!FCM1::Cm::Abort->caught($@)) {
+                die($@);
+            }
+            if (!($@->get_code() eq $@->NULL || $@->get_code() eq $@->USER)) {
+                die($@);
+            }
+            $attrib_ref->{util}->event(
+                FCM::Context::Event->CM_ABORT, lc($@->get_code()),
+            );
+            $@ = undef;
+        }
+        return;
+    };
+}
+
+# Generate an option modifier to st_check_handler.
+sub _opt_mod_st_check_handler_func {
+    my $key = shift();
+    sub {
+        my $option_ref = shift();
+        if (!$option_ref->{'non-interactive'}) {
+            $option_ref->{st_check_handler} = $FCM1::Cm::CLI_HANDLER_OF{$key};
+        }
+    };
+}
+
+# Expands keywords in arguments.
+sub _parse_args {
+    my ($attrib_ref, $option_ref, $args_ref) = @_;
+    # Location keywords
+    my $UTIL = $attrib_ref->{util};
+    my $url;
+    for my $arg (@{$args_ref}) {
+        eval {
+            my $locator = FCM::Context::Locator->new($arg);
+            if ($UTIL->loc_what_type($locator) eq 'svn') {
+                my $new_arg = $UTIL->loc_as_normalised($locator);
+                my $SVN = $attrib_ref->{svn};
+                my ($new_arg_url, $new_arg_rev) = $SVN->split_by_peg($new_arg);
+                my (    $arg_url,     $arg_rev) = $SVN->split_by_peg($arg);
+                if (index($arg_url, $UTIL->loc_kw_prefix() . ':') == 0) {
+                    $arg_url = $new_arg_url;
+                }
+                if ($arg_rev && $new_arg_rev && $arg_rev ne $new_arg_rev) {
+                    $arg_rev = $new_arg_rev;
+                }
+                $arg = $arg_url . ($arg_rev ? '@' . $arg_rev : q{});
+                $url ||= $new_arg_url;
+            }
+        };
+        if (my $e = $@) {
+            if (    !FCM::Util::Exception->caught($e)
+                ||  index($e->get_code(), 'LOCATOR_') != 0
+            ) {
+                die($e);
+            }
+            $@ = undef;
+        }
+    }
+    # Revision keywords
+    $url ||= cwd();
+    my $in_opt_rev;
+    for my $arg (@{$args_ref}) {
+        my ($opt, $opt_arg);
+        if ($in_opt_rev) {
+            $in_opt_rev = 0;
+            ($opt, $opt_arg) = (q{}, $arg);
+        }
+        elsif (grep {$_ eq $arg} qw{-c --change -r --revision}) {
+            $in_opt_rev = 1;
+        }
+        else {
+            ($opt, $opt_arg)
+                = $arg =~ qr{\A(-[cr]|--(?:change|revision)=)(.*)\z}msx;
+        }
+        if ($opt_arg) {
+            $arg = $opt . _parse_args_rev($attrib_ref, $url, $opt_arg);
+        }
+    }
+    for my $key (grep {exists($option_ref->{$_})} qw{change revision}) {
+        $option_ref->{$key}
+            = _parse_args_rev($attrib_ref, $url, $option_ref->{$key});
+    }
+}
+
+# Expands revision keywords in an argument.
+sub _parse_args_rev {
+    my ($attrib_ref, $url, $arg) = @_;
+    my $UTIL = $attrib_ref->{util};
+    join(
+        ':',
+        map {
+            my $rev = $_;
+            my $locator = FCM::Context::Locator->new($url . '@' . $rev);
+            local($@);
+            my $value = eval{$UTIL->loc_as_normalised($locator)};
+            if ($value) {
+                (my $url, $rev) = $attrib_ref->{svn}->split_by_peg($value);
+            }
+            $rev;
+        } split(qr{:}msx, $arg, 2)
+    );
+}
+
+# Invokes a system "svn" call.
+sub _svn {
+    my ($attrib_ref, $app, $option_ref, @args) = @_;
+    _parse_args($attrib_ref, $option_ref, \@args);
+    $attrib_ref->{svn}->call($app, @args);
+}
+
+#-------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::CM
+
+=head1 SYNOPSIS
+
+    use FCM::System::CM;
+    my $system = FCM::System::CM->new(\%attrib);
+    my ($out, $err) = $system->svn({}, @args);
+
+=head1 DESCRIPTION
+
+The FCM code management sub-system. This is currently a thin adaptor of
+L<FCM1::Cm|FCM1::Cm>.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Returns a new instance. This class should normally be initialised by
+L<FCM::System|FCM::System>.
+
+=item $system->cm_branch_create(\%option,@args)
+
+Implement the C<fcm branch-create> command. On success, return the branch name
+created.
+
+=item $system->cm_branch_list(\%option,@args)
+
+Implement the C<fcm branch-list> command.
+
+=item $system->cm_checkout(\%option,@args)
+
+Thin wrapper of the C<svn checkout> command. Ensure checkout to clean location.
+
+=item $system->cm_diff(\%option,@args)
+
+Thin wrapper of the C<svn diff> command. Allow --graphical option.
+
+=item $system->cm_loc_layout(\%option,@args)
+
+Implement the C<fcm loc-layout> command.
+
+=item $system->cm_project_create(\%option,@args)
+
+Implement the C<fcm project-create> command.
+
+=item $system->cm_branch_delete(\%option,@args)
+=item $system->cm_branch_info(\%option,@args)
+=item $system->cm_commit(\%option,@args)
+=item $system->cm_check_missing(\%option,@args)
+=item $system->cm_check_unknown(\%option,@args)
+=item $system->cm_merge(\%option,@args)
+=item $system->cm_mkpatch(\%option,@args)
+=item $system->cm_resolve_conflicts(\%option,@args)
+=item $system->cm_switch(\%option,@args)
+=item $system->cm_update(\%option,@args)
+
+Thin adaptors for the corresponding code management functions in
+L<FCM1::Cm|FCM1::Cm>.
+
+=item $system->svn($app,\%option,@args)
+
+Invokes a system call to L<svn|svn> $app with @args. %option is not currently
+used, but is left in the argument list for compatibility with the other methods.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM/CommitMessage.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM/CommitMessage.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM/CommitMessage.pm	(revision 5095)
@@ -0,0 +1,312 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# Utility to manipulate FCM commit messages.
+package FCM::System::CM::CommitMessage;
+use base qw{FCM::Class::CODE};
+
+use Cwd qw{cwd};
+use FCM::Context::Event;
+use FCM::System::Exception;
+use File::Spec::Functions qw{catfile};
+use File::Temp;
+use Text::ParseWords qw{shellwords};
+
+my $CTX = 'FCM::System::CM::CommitMessage::State';
+my $E = 'FCM::System::Exception';
+
+our $COMMIT_MESSAGE_BASE = '#commit_message#';
+our $DELIMITER_USER
+    = '--Add your commit message ABOVE - do not alter this line or those below--'
+    . "\n";
+our $DELIMITER_AUTO
+    = '--FCM message (will be inserted automatically)--'
+    . "\n";
+our $DELIMITER_INFO
+    = '--Change summary (not part of commit message)--'
+    . "\n";
+our $EDITOR = 'vi';
+our $GEDITOR = 'gvim -f';
+our $SUBVERSION_CONFIG_FILE = catfile((getpwuid($<))[7], qw{.subversion/config});
+
+__PACKAGE__->class({gui => '$', util => '&'},
+    {action_of => {
+        'ctx'       => sub {$CTX->new()},
+        'edit'      => \&_edit,
+        'load'      => \&_load,
+        'notify'    => \&_notify,
+        'path'      => \&_path,
+        'path_base' => sub {$COMMIT_MESSAGE_BASE},
+        'save'      => \&_save,
+        'temp'      => \&_temp,
+    }},
+);
+
+# Invokes an editor to edit the commit message context.
+sub _edit {
+    my ($attrib_ref, $commit_message_ctx) = @_;
+    my $UTIL = $attrib_ref->{'util'};
+    my $temp = File::Temp->new();
+    if ($commit_message_ctx->get_user_part()) {
+        print($temp $commit_message_ctx->get_user_part());
+    }
+    else {
+        print($temp "\n");
+    }
+    print($temp $DELIMITER_USER);
+    if ($commit_message_ctx->get_auto_part()) {
+        print($temp $DELIMITER_AUTO . $commit_message_ctx->get_auto_part());
+    }
+    print($temp $DELIMITER_INFO . $commit_message_ctx->get_info_part());
+    close($temp) || die("$temp: $!\n");
+    my $config_value;
+    my $editor_command
+        = $ENV{'SVN_EDITOR'} ? $ENV{'SVN_EDITOR'}
+        : ($config_value = _svn_config_get($attrib_ref, 'helpers', 'editor-cmd'))
+                             ? $config_value
+        : $ENV{'VISUAL'}     ? $ENV{'VISUAL'}
+        : $ENV{'EDITOR'}     ? $ENV{'EDITOR'}
+        : $attrib_ref->{gui} ? $GEDITOR
+        :                      $EDITOR
+        ;
+    $UTIL->event(FCM::Context::Event->CM_LOG_EDIT, $editor_command);
+    my @command = (shellwords($editor_command), $temp->filename());
+    !system(@command)
+        || return $E->throw($E->SHELL, {command_list => \@command, rc => $?});
+    # Note: cannot use FCM::Util->shell method for terminal based editor.
+    #my %value_of = %{$attrib_ref->{'util'}->shell_simple(\@command)};
+    #if ($value_of{'rc'}) {
+    #    return $E->throw($E->SHELL, {command_list => \@command, %value_of});
+    #}
+    my $user_part = _parse(
+        $attrib_ref,
+        scalar($UTIL->file_load($temp->filename())),
+        $DELIMITER_USER,
+    );
+    $commit_message_ctx->set_user_part($user_part);
+    if (($user_part . $commit_message_ctx->get_auto_part()) =~ qr{\A\s*\z}msx) {
+        return $E->throw($E->CM_LOG_EDIT_NULL);
+    }
+}
+
+# Reads a commit message file from $path or the standard location. Returns a
+# commit message context object.
+sub _load {
+    my ($attrib_ref, $path) = @_;
+    $path ||= _path($attrib_ref);
+    my ($user_part, $auto_part) = eval {
+        _parse($attrib_ref, scalar($attrib_ref->{'util'}->file_load($path)));
+    };
+    if (my $e = $@) {
+        $user_part = q{};
+        $auto_part = q{};
+        $@ = undef; # TODO: should raise a high verbosity event?
+    }
+    $CTX->new({'user_part' => $user_part, 'auto_part' => $auto_part});
+}
+
+# Raises an CM_COMMIT_MESSAGE event for the commit message.
+sub _notify {
+    my ($attrib_ref, $commit_message_ctx) = @_;
+    $attrib_ref->{util}->event(
+        FCM::Context::Event->CM_COMMIT_MESSAGE, $commit_message_ctx,
+    );
+}
+
+# Parses a commit message into the user and auto parts. Returns the user part in
+# scalar context. Returns (user_part, auto_part) in list context.
+sub _parse {
+    my ($attrib_ref, $message, $no_delimiter_user) = @_;
+    my @parts = (q{}, q{});
+    my $state = 0;
+    LINE:
+    for my $line (split("\n", $message)) {
+        if ($state && !wantarray()) {
+            last LINE;
+        }
+        $line .= "\n";
+        if ($line eq $DELIMITER_INFO) {
+            last LINE;
+        }
+        elsif ($line eq $DELIMITER_AUTO) {
+            $state = 1;
+            next LINE;
+        }
+        elsif ($line eq $DELIMITER_USER) {
+            $no_delimiter_user = undef;
+            $state = -1;
+            next LINE;
+        }
+        if ($state >= 0) {
+            $parts[$state] .= $line;
+        }
+    }
+    if ($no_delimiter_user) {
+        return $E->throw($E->CM_LOG_EDIT_DELIMITER, $DELIMITER_USER);
+    }
+    for my $part (@parts) {
+        $part =~ s{\A\s*(.*?)\s*\z}{$1}msx;
+        if ($part) {
+            $part .= "\n";
+        }
+    }
+    wantarray() ? @parts : $parts[0];
+}
+
+# Returns the path to the commit message file in the current working directory
+# or the commit message file in $dir if $dir is set.
+sub _path {
+    my ($attrib_ref, $dir) = @_;
+    catfile(($dir ? $dir : cwd()), $COMMIT_MESSAGE_BASE);
+}
+
+# Saves the commit message to $path or the standard location for later
+# retrieval.
+sub _save {
+    my ($attrib_ref, $commit_message_ctx, $path) = @_;
+    $path ||= _path($attrib_ref);
+    my $string = $commit_message_ctx->get_user_part();
+    if ($commit_message_ctx->get_auto_part()) {
+        $string .= $DELIMITER_AUTO . $commit_message_ctx->get_auto_part();
+    }
+    $attrib_ref->{'util'}->file_save($path, $string);
+}
+
+# Returns a File::Temp object containing a commit message ready for the VCS.
+sub _temp {
+    my ($attrib_ref, $commit_message_ctx) = @_;
+    my $temp = File::Temp->new();
+    print($temp $commit_message_ctx->get_user_part());
+    print($temp $commit_message_ctx->get_auto_part());
+    close($temp) || die("$temp: $!\n");
+    $temp;
+}
+
+# Loads a setting from $HOME/.subversion/config, and returns its value.
+sub _svn_config_get {
+    my ($attrib_ref, $section, $key) = @_;
+    # Note: can use Config::IniFiles, but best to avoid another dependency.
+    # Note: not very efficient logic here, but should not yet matter.
+    my $handle = $attrib_ref->{'util'}->file_load_handle($SUBVERSION_CONFIG_FILE);
+    my $is_in_section;
+    my $value;
+    LINE:
+    while (my $line = readline($handle)) {
+        chomp($line);
+        if ($line =~ qr{\A\s*(?:[#;]|\z)}msx) {
+            next LINE;
+        }
+        if ($line =~ qr{\A\s*\[\s*$section\s*\]\s*\z}msx) {
+            $is_in_section = 1;
+        }
+        elsif ($line =~ qr{\A\s*\[}msx) {
+            $is_in_section = 0;
+        }
+        elsif ($is_in_section) {
+            my ($rhs) = $line =~ qr{\A\s*$key\s*=\s*(.*)\z}msx;
+            if (defined($rhs)) {
+                $value = $rhs;
+            }
+        }
+    }
+    close($handle);
+    $value;
+}
+
+#-------------------------------------------------------------------------------
+package FCM::System::CM::CommitMessage::State;
+use base qw{FCM::Class::HASH};
+
+__PACKAGE__->class({
+    (map {($_ . '_part' => {isa => '$', default => q{}})} qw{auto info user}),
+});
+
+#-------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::CM::CommitMessage
+
+=head1 SYNOPSIS
+
+    use FCM::System::CM::CommitMessage;
+    my $commit_message_util = FCM::System::CM::CommitMessage->new(\%attrib);
+    my $commit_message_ctx = $commit_message_util->ctx();
+    $commit_message_util->edit($ctx);
+
+=head1 DESCRIPTION
+
+The commit message dumper, editor, loader, parser, etc for the FCM code
+management sub-system.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Return a new instance. This class should normally be initialised by
+L<FCM::System::CM|FCM::System::CM>.
+
+=item $commit_message_util->ctx()
+
+Return a new and empty commit message context.
+
+=item $commit_message_util->edit($commit_message_ctx)
+
+Invoke an editor to edit the commit message context.
+
+=item $commit_message_util->load($path)
+
+Load the content of a commit message file in $path, and return the result in a
+new commit message context.
+
+=item $commit_message_util->notify($commit_message_ctx)
+
+Raise a CM_COMMIT_MESSAGE event with the $commit_message_ctx.
+
+=item $commit_message_util->path($dir)
+
+Return the path to the commit message file in $dir or the current working
+directory if $dir is not specified.
+
+=item $commit_message_util->path($dir)
+
+Return the base name of the commit message file.
+
+=item $commit_message_util->save($commit_message_ctx, $path)
+
+Save the commit message to $path (or the standard location if $path is not
+specified).
+
+=item $commit_message_util->temp()
+
+Return a File::Temp object containing a commit message ready for the VCS.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM/Prompt.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM/Prompt.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM/Prompt.pm	(revision 5095)
@@ -0,0 +1,223 @@
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+#-------------------------------------------------------------------------------
+package FCM::System::CM::Prompt;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::Event;
+
+our $TYPE_YN = 'TYPE_YN';
+
+# Format string table
+my %S = (
+    'BRANCH_CREATE'     => 'Create the branch?',
+    'OVERWRITE'         => '%s: file exists, overwrite?',
+    'PROJECT_CREATE'    => 'Create the project?',
+    'RESOLVE'           => 'Run "svn resolve --accept working %s"?',
+    'TC'                => "Locally: %s.\n"
+                           . "Externally: %s.\n"
+                           . "Answer (y) to %s.\n"
+                           . "Answer (n) to %s.\n"
+                           . '%s'
+                           . 'Keep the local version?',
+    'TC_ACTION'         => 'accept the %s %s',
+    'TC_ACTION_ADD'     => 'keep the %s file filename',
+    'TC_ACTION_EDIT'    => 'keep the file',
+    'TC_FROM_LOC'       => 'local',
+    'TC_FROM_INC'       => 'external',
+    'TC_MERGE'          => "You can then merge in changes.\n",
+    'TC_ST_ADD'         => 'added',
+    'TC_ST_DELETE'      => 'deleted',
+    'TC_ST_EDIT'        => 'edited',
+    'TC_ST_REPLACE'     => 'replaced',
+    'TC_ST_RENAME'      => 'renamed to %s',
+);
+
+# Configuration for questions
+# KEY => {'format' => $|&, 'type' => $}
+my %Q_CONF = (
+    # Simple question prompts
+    (   map {($_ => {'format' => $S{$_}, 'type' => q{}})}
+            qw{BRANCH_CREATE OVERWRITE PROJECT_CREATE RESOLVE}
+    ),
+    # Tree conflicts prompts: TC_LxIy, for local x, incoming y
+    # where x and y correspond to:
+    # A => add,
+    # D => delete,
+    # E => edit,
+    # M => missing,
+    # P => replace,
+    # R => rename
+    (   map {('TC_' . $_ => {'format' => \&_q_tree_conflict, 'type' => $TYPE_YN})}
+            qw(LAIA LDID LDIE LDIR LEID LEIP LEIR LRID LRIE LRIR)
+    ),
+);
+
+__PACKAGE__->class(
+    {gui => '$', util => '&'},
+    {init => \&_init, action_of => {question => \&_q}},
+);
+
+sub _init {
+    my $attrib_ref = shift();
+    my $class = $attrib_ref->{gui}
+        ? 'FCM::System::CM::Prompt::Zenity' : 'FCM::System::CM::Prompt::Simple';
+    $attrib_ref->{impl} = $class->new({util => $attrib_ref->{util}});
+}
+
+sub _q {
+    my ($attrib_ref, $key, @args) = @_;
+    my $format = $Q_CONF{$key}{'format'};
+    my $prompt = ref($format) ? $format->(@args) : sprintf($format, @args);
+    $attrib_ref->{'impl'}->question($Q_CONF{$key}{'type'}, $prompt);
+}
+
+# Tree conflict prompt.
+# $tree_key is the FCM::System::CM::TreeConflictKey for the conflict.
+# $rename_loc is the new local name for the conflict file, if any.
+# $rename_inc is the new incoming name for the conflict file, if any.
+sub _q_tree_conflict {
+    my ($tree_key, $rename_loc, $rename_inc) = @_;
+    my %opt_of = (
+        'loc' => {'key' => $tree_key->get_local()   , 'rename' => $rename_loc},
+        'inc' => {'key' => $tree_key->get_incoming(), 'rename' => $rename_inc},
+    );
+    sprintf($S{'TC'}, (
+        (   map {
+                my $opt = $_;
+                my $message = $S{'TC_ST_' . uc($opt->{'key'})};
+                if ($opt->{'key'} eq 'rename') {
+                    $message = sprintf($message, $opt->{'rename'});
+                }
+                $message;
+            }
+            @opt_of{'loc', 'inc'}
+        ),
+        (   map {
+                my $location_key = $_;
+                my $from = $S{'TC_FROM_' . uc($location_key)};
+                my $key = $opt_of{$location_key}->{'key'};
+                  $key eq 'add'     ? sprintf($S{'TC_ACTION_ADD'}, $from)
+                : $key eq 'edit'    ? $S{'TC_ACTION_EDIT'}
+                :                     sprintf($S{'TC_ACTION'}, $from, $key)
+                ;
+            }
+            ('loc', 'inc')
+        ),
+        (   (        (grep {$opt_of{'loc'}{'key'} eq $_} qw{rename edit})
+                &&   (grep {$opt_of{'inc'}{'key'} eq $_} qw{rename edit})
+            )
+            ? $S{'TC_MERGE'} : q{}
+        ),
+    ));
+}
+
+#-------------------------------------------------------------------------------
+package FCM::System::CM::Prompt::Simple;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::Event;
+
+our %SETTING_OF = (
+    q{}       => {'choices' => [qw{y n}], 'default' => 'n', 'positive' => 'y'},
+    'TYPE_YN' => {'choices' => [qw{y n}], 'default' => 'n', 'positive' => 'y'},
+);
+
+__PACKAGE__->class({util => '&'}, {action_of => {question => \&_question}});
+
+sub _question {
+    my ($attrib_ref, $type, $question) = @_;
+    my %setting = %{$SETTING_OF{$type}};
+    _prompt($attrib_ref, $question, $setting{'choices'}, $setting{'default'})
+        eq $setting{'positive'};
+}
+
+sub _prompt {
+    my ($attrib_ref, $question, $choices_ref, $default) = @_;
+    my ($tail, @heads) = reverse(@{$choices_ref});
+    my $prompt
+        = $question . "\n"
+        . sprintf('Enter "%s" or "%s"', join(q{, }, reverse(@heads)), $tail)
+        . sprintf(' (or just press <return> for "%s") ', $default);
+    my $answer;
+    while (!defined($answer)) {
+        $attrib_ref->{util}->event(FCM::Context::Event->OUT, $prompt);
+        $answer = readline(STDIN);
+        chomp($answer);
+        if (!$answer) {
+            $answer = $default;
+        }
+        if (!grep {$_ eq $answer} @{$choices_ref}) {
+            $answer = undef;
+        }
+    }
+    return $answer;
+}
+
+#-------------------------------------------------------------------------------
+package FCM::System::CM::Prompt::Zenity;
+use base qw{FCM::Class::CODE};
+
+our %OPTIONS_OF = (
+    q{}       => [],
+    'TYPE_YN' => ['--ok-label=_Yes', '--cancel-label=_No'],
+);
+
+__PACKAGE__->class({util => '&'}, {action_of => {question => \&_question}});
+
+sub _question {
+    my ($attrib_ref, $type, $question) = @_;
+    _zenity($attrib_ref, qw{--question --text}, $question, @{$OPTIONS_OF{$type}});
+}
+
+sub _zenity {
+    my ($attrib_ref, @args) = @_;
+    my @command = ('zenity', @args);
+    my %value_of = %{$attrib_ref->{util}->shell_simple(\@command)};
+    !$value_of{rc};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::CM::Prompt
+
+=head1 SYNOPSIS
+
+    use FCM::System::CM::Prompt;
+    my $prompt = FCM::System::CM::Prompt->new(\%attrib);
+    if ($prompt->question($key, @args)) {
+        # do something
+    }
+
+=head1 DESCRIPTION
+
+Helper module for prompts in the FCM code management sub-system.
+See L<FCM::System::CM|FCM::System::CM> for detail.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM/ResolveConflicts.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM/ResolveConflicts.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM/ResolveConflicts.pm	(revision 5095)
@@ -0,0 +1,685 @@
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+#-------------------------------------------------------------------------------
+package FCM::System::CM::ResolveConflicts;
+use base qw{Exporter};
+our @EXPORT_OK = qw{_cm_resolve_conflicts};
+
+use Cwd qw{cwd};
+use FCM::Context::Event;
+use FCM::System::Exception;
+use File::Basename qw{basename dirname};
+use File::Copy qw{copy};
+use File::Spec::Functions qw{abs2rel catfile rel2abs};
+use File::Temp;
+
+# LxIy stands for local x, incoming y in the tree conflict description.
+# The letters of x and y correspond to:
+# A => add,
+# D => delete,
+# E => edit,
+# M => missing,
+# P => replace,
+# R => rename,
+# although the 'rename' has to be detected by our code below.
+
+our %TREE_CONFLICT_GET_GRAPHIC_SOURCES_FUNC_FOR = (
+    LEIR => \&_cm_tree_conflict_get_graphic_sources_for_leir,
+    LRIE => \&_cm_tree_conflict_get_graphic_sources_for_lrie,
+    LRIR => \&_cm_tree_conflict_get_graphic_sources_for_lrir,
+);
+
+# A tree conflict key must be present here for auto-resolving.
+our %TREE_CONFLICT_GET_FINAL_ACTIONS_FUNC_FOR = (
+    LAIA => \&_cm_tree_conflict_get_actions_for_laia,
+    LDID => sub {},
+    LDIE => \&_cm_tree_conflict_get_actions_for_ldie,
+    LDIR => \&_cm_tree_conflict_get_actions_for_ldir,
+    LEID => \&_cm_tree_conflict_get_actions_for_leid,
+    LEIR => \&_cm_tree_conflict_get_actions_for_leir,
+    LEIP => \&_cm_tree_conflict_get_actions_for_leip,
+    LRID => \&_cm_tree_conflict_get_actions_for_lrid,
+    LRIE => \&_cm_tree_conflict_get_actions_for_lrie,
+    LRIR => \&_cm_tree_conflict_get_actions_for_lrir,
+);
+
+# Handle aliases for actions.
+our %TREE_CONFLICT_GET_UNALIAS_FOR = (
+    'obstruction' => 'add',
+    'missing' => 'delete',
+);
+
+# Number of renamed files that triggers a time warning.
+our $TREE_CONFLICT_WARN_FILES_THRESHOLD = 10;
+
+my $E = 'FCM::System::Exception';
+# Regular expressions
+my %RE = (
+    # determines if a file was copied, i.e. added with history from "svn status"
+    ST_COPIED => qr{^A..\+....(.*)}msx,
+);
+
+# Resolve conflicts.
+sub _cm_resolve_conflicts {
+    my ($attrib_ref, $option_ref, @args) = @_;
+    my $UTIL = $attrib_ref->{util};
+    my $pwd = cwd();
+    if (!@args) {
+        push(@args, '.');
+    }
+    for my $arg (@args) {
+        if (!-e $arg) {
+            die("$arg: $!\n");
+        }
+        chdir($attrib_ref->{svn}->get_wc_root($arg)) || die("$arg: $!\n");
+        my @command = qw{svn status};
+        my %value_of = %{$UTIL->shell_simple(\@command)};
+        if ($value_of{rc}) {
+            return $E->throw($E->SHELL, {command_list => \@command, %value_of});
+        }
+        my @status_lines = grep {$_} split("\n", $value_of{o});
+        local(%ENV) = %ENV;
+        $ENV{FCM_GRAPHIC_MERGE} ||= $UTIL->external_cfg_get('graphic-merge');
+        for my $path (map {($_ =~ qr{\AC.{6}\s(.*)\z}msx)} @status_lines) {
+            _cm_resolve_text_conflict(
+                $attrib_ref,
+                $option_ref,
+                $path,
+                @status_lines,
+            );
+        }
+        for my $path (map {($_ =~ qr{\A.{6}C\s(.*)\z}msx)} @status_lines) {
+            _cm_resolve_tree_conflict(
+                $attrib_ref,
+                $option_ref,
+                $path,
+                @status_lines,
+            );
+        }
+    }
+    chdir($pwd);
+}
+
+# Helper for _cm_resolve_conflicts, launch graphic merge tool.
+sub _cm_graphic_merge {
+    my $attrib_ref = shift();
+    my @command = ('fcm_graphic_merge', @_);
+    my $UTIL = $attrib_ref->{util};
+    my %value_of = %{$UTIL->shell_simple(\@command)};
+    # rc==0: all conflicts resovled
+    # rc==1: some conflicts not resolved
+    # rc==2: trouble
+    if (!grep {$_ eq $value_of{rc}} (0, 1)) {
+        return $E->throw(
+            $E->SHELL, {command_list => \@command, %value_of}, $value_of{e},
+        );
+    }
+    $UTIL->event(FCM::Context::Event->OUT, $value_of{o});
+    $value_of{rc};
+}
+
+# Resolve a text conflict.
+sub _cm_resolve_text_conflict {
+    my ($attrib_ref, $option_ref, $path) = @_;
+    my $PROMPT = $attrib_ref->{prompt};
+    my $UTIL = $attrib_ref->{util};
+    if (-B $path) {
+        $UTIL->event(FCM::Context::Event->CM_CONFLICT_TEXT_SKIP, $path);
+        return;
+    }
+    $UTIL->event(FCM::Context::Event->CM_CONFLICT_TEXT, $path);
+
+    # Get conflicts markers files
+    my %info = %{$attrib_ref->{svn}->get_info($path)->[0]};
+    my @keys = map {"conflict:$_-file"} qw{prev-wc prev-base cur-base};
+    # Subversion 1.6: conflict filenames are relative paths.
+    # Subversion 1.8: conflict filenames are absolute paths.
+    my ($mine, $older, $yours) = map {
+        rel2abs($_, rel2abs(dirname($path)))
+    } @info{@keys};
+
+    # If $path is newer (by more than a second), it may contain saved changes.
+    if (    -f $path && (stat($path))[9] > (stat($mine))[9] + 1
+        &&  !$PROMPT->question('OVERWRITE', $path)
+    ) {
+        return;
+    }
+
+    # Launch graphic merge tool
+    if (_cm_graphic_merge($attrib_ref, $path, $mine, $older, $yours)) {
+        return; # rc==1, some conflicts not resolved
+    }
+
+    # Prompt user to run "svn resolve --accept working" on the file
+    if ($PROMPT->question('RESOLVE', $path)) {
+        $attrib_ref->{svn}->call(qw{resolve --accept working}, $path);
+    }
+}
+
+# Resolve a tree conflict.
+sub _cm_resolve_tree_conflict {
+    my ($attrib_ref, $option_ref, $path, @status_lines) = @_;
+    my $PROMPT = $attrib_ref->{prompt};
+    my $UTIL = $attrib_ref->{util};
+
+    # Skip directories - too complex for now.
+    if (-d $path) {
+        $UTIL->event(FCM::Context::Event->CM_CONFLICT_TREE_SKIP, $path);
+        return;
+    }
+
+    # Get basic information about the tree conflict, and the filename.
+    my %info = %{$attrib_ref->{svn}->get_info($path)->[0]};
+
+    # Skip non-existent or unhandled tree conflicts.
+    if (!exists($info{'tree-conflict:operation'})) {
+        return
+    }
+    if ($info{'tree-conflict:operation'} ne 'merge') {
+        $UTIL->event(FCM::Context::Event->CM_CONFLICT_TREE_SKIP, $path);
+        return;
+    }
+    
+    my $tree_reason = $info{'tree-conflict:reason'};
+    if (grep {$tree_reason eq $_} keys(%TREE_CONFLICT_GET_UNALIAS_FOR)) {
+        $tree_reason = $TREE_CONFLICT_GET_UNALIAS_FOR{$tree_reason};
+    }
+    my $tree_key = FCM::System::CM::TreeConflictKey->new(
+        {   'local'    => $tree_reason,
+            'incoming' => $info{'tree-conflict:action'},
+            'type'     => $info{'tree-conflict:operation'},
+        },
+    );
+    my $tree_filename = $info{'path'};
+
+    my %wc_info = %{$attrib_ref->{svn}->get_info()->[0]};
+
+    my $repos_root = $wc_info{'repository:root'};
+    my $wc_branch = substr($wc_info{'url'}, length($repos_root) + 1);
+
+    my $tree_full_filename = '/' . $wc_branch . '/' . $tree_filename;
+
+    # Check for external renaming, by examining files added with history
+    my $ext_renamed_file = '';
+    my $ext_branch = '';
+    COPIED_FILE:
+    for my $copied_file (map {($_ =~ $RE{ST_COPIED})} @status_lines) {
+        my %copy_info = %{$attrib_ref->{svn}->get_info($copied_file)->[0]};
+        my $url = (
+              $copy_info{'wc-info:copy-from-url'}
+            . '@' . $copy_info{'wc-info:copy-from-rev'}
+        );
+        my $copy_log_ref = $attrib_ref->{svn}->get_log($url);
+        if (!$ext_branch) {
+            my $copy_full_path = substr(
+                $copy_info{'wc-info:copy-from-url'},
+                length($repos_root) + 1,
+            );
+            $ext_branch = substr(
+                $copy_full_path,
+                0,
+                -length($copied_file) - 1,
+            );
+        }
+        my $copied_full_filename = '/' . $ext_branch . '/' . $copied_file;
+        my $tree_ext_name
+            = ('/' . $info{'tree-conflict:source-right:path-in-repos'});
+        my $search_name = $tree_ext_name;
+        for my $log_entry_ref (reverse(@{$copy_log_ref})) {
+            for my $path_entry (@{$log_entry_ref->{'paths'}}) {
+                if (    exists $path_entry->{'copyfrom-path'}
+                    &&  $path_entry->{'copyfrom-path'} eq $search_name
+                ) {
+                    $search_name = $path_entry->{'path'};
+                    if ($search_name eq $copied_full_filename) {
+                        $ext_renamed_file = $copied_file;
+                        last COPIED_FILE;
+                    }
+                }
+            }
+        }
+    }
+
+    # Check for local renaming of the tree conflict file
+    my $local_renamed_file = '';
+    if ($tree_reason eq 'delete') {
+        $local_renamed_file = _cm_tree_conflict_get_local_rename(
+            $attrib_ref,
+            $wc_branch,
+            $tree_full_filename,
+            $ext_renamed_file
+        );
+    }
+
+    # The tree conflict identifier (tree_key) needs to be adjusted for reality
+    if ($local_renamed_file) {
+        $tree_key->set_local('rename');
+    }
+    if ($ext_renamed_file) {
+        $tree_key->set_incoming('rename');
+    }
+
+    # Skip and return if the tree key does not match a key in final cmds.
+    my $cmds_getter
+        = $TREE_CONFLICT_GET_FINAL_ACTIONS_FUNC_FOR{$tree_key->as_string()};
+    if (!$cmds_getter) {
+        $UTIL->event(FCM::Context::Event->CM_CONFLICT_TREE_SKIP, $path);
+        return;
+    }
+
+    # Print the tree conflict event message
+    $UTIL->event(FCM::Context::Event->CM_CONFLICT_TREE, $path);
+
+    # These are the relevant files for this tree conflict.
+    my @file_args = grep {$_} ($path, $local_renamed_file, $ext_renamed_file);
+
+    # Prompt which version of events to accept - local or incoming.
+    my $keep_local = $PROMPT->question(
+        'TC_' . $tree_key->as_string(),
+        $tree_key, $local_renamed_file, $ext_renamed_file,
+    );
+
+    # Add any graphic merge commands
+    my @cmds = _cm_tree_conflict_get_graphic_cmds(
+        $attrib_ref, $tree_key->as_string(), $keep_local, \@file_args,
+    );
+    # Now load any miscellaneous actions or commands - for example 'svn delete'
+    if ($tree_key->get_local() eq 'add' && $tree_key->get_incoming() eq 'add') {
+        # We need to generate a new filename and a temporary one in this case.
+        @file_args = ($path);
+        my $tree_dir = dirname($path);
+        my $newfile_handle = File::Temp->new(
+            DIR => $tree_dir,
+            TEMPLATE => basename($path) . '.XXXX',
+            UNLINK => 0,
+        );
+        unlink("$newfile_handle");  # Delete it, or it will block the copy.
+        push(@file_args, "$newfile_handle");
+    }
+    push(@cmds, $cmds_getter->($attrib_ref, $keep_local, \@file_args));
+
+    # Run the actions, including any subroutine references.
+    for my $cmd_ref (@cmds) {
+        $cmd_ref->();
+    }
+    # svn resolve.
+    $attrib_ref->{svn}->call(qw{resolve --accept working}, $path);
+}
+
+# Tree conflicts: check if a file was renamed locally.
+sub _cm_tree_conflict_get_local_rename {
+    my ($attrib_ref, $wc_branch, $tree_full_filename, $ext_renamed_file) = @_;
+    my $UTIL = $attrib_ref->{util};
+
+    # Get the verbose log for the working copy.
+    # Find the revision where the file was deleted, and store any copied
+    # filenames at that revision, and since that revision.
+    my ($d_rev, @rev_copied_filenames, $found_delete);
+    my @since_copied_filenames;
+    my $wc_log_ref = $attrib_ref->{svn}->get_log();
+    ENTRY:
+    for my $log_entry_ref (@{$wc_log_ref}) {
+        $d_rev = $log_entry_ref->{'revision'};
+        @rev_copied_filenames = ();
+        for my $path_entry (@{$log_entry_ref->{'paths'}}) {
+            if ($path_entry->{'copyfrom-path'}) {
+                push(@rev_copied_filenames, $path_entry->{'path'});
+                push(@since_copied_filenames, $path_entry->{'path'});
+            }
+            if (    $path_entry->{'path'} eq $tree_full_filename
+                &&  $path_entry->{'action'} eq 'D'
+            ) {
+                $found_delete = 1;
+            }
+        }
+        if ($found_delete) {
+            last ENTRY;
+        }
+    }
+
+    # We need to detect a copy and a deletion of the file to continue.
+    if (!$found_delete || !@rev_copied_filenames) {
+        return;
+    }
+
+    # Get rid of the branch name in our copied files
+    for my $copied_file (@rev_copied_filenames) {
+        $copied_file =~ s{^/$wc_branch/}{}msx;
+    }
+    for my $copied_file (@since_copied_filenames) {
+        $copied_file =~ s{^/$wc_branch/}{}msx;
+    }
+
+    # Get the pre-existing working copy files.
+    my @wc_files
+        = grep {$_ && $_ =~ qr{[^/]$}msx}
+            $attrib_ref->{svn}->stdout(qw{svn ls -R});
+
+    # Examine the files added with history at the revision log.
+    # A single rename will be detected here.
+    my @result;
+    COPIED_AT_REV_FILE:
+    for my $file (@rev_copied_filenames) {
+        if (!grep {$_ eq $file} @wc_files) {
+            next COPIED_AT_REV_FILE;
+        }
+        my @log_entry_refs
+            = @{$attrib_ref->{svn}->get_log($file . '@' . $d_rev)};
+        my $search_name = $tree_full_filename;
+        my $full_potential_rename = '/' . $wc_branch . '/' . $file;
+        for my $log_entry_ref (@log_entry_refs) {
+            for my $path_entry (@{$log_entry_ref->{'paths'}}) {
+                if (    exists($path_entry->{'copyfrom-path'})
+                    &&  $path_entry->{'copyfrom-path'} eq $tree_full_filename
+                    &&  $path_entry->{'action'} eq 'A'
+                    &&  $path_entry->{'path'} eq $full_potential_rename
+                ) {
+                    return $file;
+                }
+            }
+        }
+    }
+
+    # If no rename was detected, there may have been more than one.
+    # Get the logs for all current filenames that match copied filenames
+    # since the deletion, according to the working copy log.
+
+    # Warn if the number of files to be examined > the threshold.
+    if (    @wc_files > $TREE_CONFLICT_WARN_FILES_THRESHOLD
+        &&  @since_copied_filenames > $TREE_CONFLICT_WARN_FILES_THRESHOLD
+    ) {
+        my $tree_path = substr($tree_full_filename, length($wc_branch) + 2);
+        $UTIL->event(
+            FCM::Context::Event->CM_CONFLICT_TREE_TIME_WARN,
+            $tree_path,
+        );
+    }
+    WC_FILE:
+    for my $file (@wc_files) {
+        if (!grep {$_ eq $file} @since_copied_filenames) {
+            next WC_FILE;
+        }
+        my @log_entry_refs = @{$attrib_ref->{svn}->get_log($file)};
+        my $search_name = $tree_full_filename;
+        my $full_potential_rename = '/' . $wc_branch . '/' . $file;
+        for my $log_entry_ref (reverse(@log_entry_refs)) {
+            my $revision = $log_entry_ref->{'revision'};
+            for my $path_entry (@{$log_entry_ref->{'paths'}}) {
+                if (    exists($path_entry->{'copyfrom-path'})
+                    &&  $path_entry->{'copyfrom-path'} eq $search_name
+                    &&  $path_entry->{'action'} eq 'A'
+                ) {
+                    $search_name = $path_entry->{'path'};
+                    if (   $search_name eq $full_potential_rename
+                        && $revision >= $d_rev
+                    ) {
+                        return $file;
+                    }
+                }
+            }
+        }
+    }
+    return;
+}
+
+# Return the tree conflict command related to fcm_graphic_merge.
+sub _cm_tree_conflict_get_graphic_cmds {
+    my ($attrib_ref, $key, $keep_local, $files_ref) = @_;
+    my ($cfile, @rename_args) = @{$files_ref};
+    if (!@rename_args) {
+        return;
+    }
+    # Get the source argument subroutine reference, if it exists.
+    my $get_srcs_func_ref = $TREE_CONFLICT_GET_GRAPHIC_SOURCES_FUNC_FOR{$key};
+    if (!$get_srcs_func_ref) {
+        return;
+    }
+    # Get the sources for the graphic merge files.
+    my ($older_src, $merge_src, $working_src, $base)
+        = $get_srcs_func_ref->($cfile, $keep_local, \@rename_args);
+
+    # Set up the filenames.
+    my ($older_url, $older_peg)
+        = _cm_tree_conflict_source($attrib_ref, 'left', $older_src);
+    my $mine = $base . '.working';
+    my $older = $base . '.merge-left.r' . $older_peg;
+    my ($merge_url, $merge_peg)
+        = _cm_tree_conflict_source($attrib_ref, 'right', $merge_src);
+    my $yours = $base . '.merge-right.r' . $merge_peg;
+    # Set up the conflict files as in a text conflict.
+    sub {
+        $attrib_ref->{svn}->call(qw{export -q}, $older_url, $older);
+        $attrib_ref->{svn}->call(qw{export -q}, $merge_url, $yours);
+        copy($working_src, $mine);
+        _cm_graphic_merge($attrib_ref, $base, $mine, $older, $yours);
+        unlink($mine, $older, $yours);
+    };
+}
+
+# Return the source-left or source-right url from svn info.
+sub _cm_tree_conflict_source {
+    my ($attrib_ref, $direction, $info_filename) = @_;
+    my %info = %{$attrib_ref->{svn}->get_info($info_filename)->[0]};
+    my ($source_url, $source_peg);
+    if ($info{"tree-conflict:source-$direction:repos-url"}) {
+        $source_url
+            = $info{"tree-conflict:source-$direction:repos-url"}
+            . '/'
+            . $info{"tree-conflict:source-$direction:path-in-repos"};
+        $source_peg = $info{"tree-conflict:source-$direction:revision"};
+    }
+    elsif ($direction eq 'right') {
+        $source_url = $info{'wc-info:copy-from-url'};
+        $source_peg = $info{'wc-info:copy-from-rev'};
+    }
+    ($source_url . '@' . $source_peg, $source_peg);
+}
+
+# Select the files needed for the xxdiff (local edit, incoming rename)
+sub _cm_tree_conflict_get_graphic_sources_for_leir {
+    my ($cfile, $keep_local, $renames) = @_;
+    my $ext_rename = shift(@{$renames});
+    (   $cfile,
+        $ext_rename,
+        $cfile,
+        ($keep_local ? $cfile : $ext_rename),
+    );
+}
+
+# Select the files needed for the xxdiff (local rename, incoming edit)
+sub _cm_tree_conflict_get_graphic_sources_for_lrie {
+    my ($cfile, $keep_local, $renames) = @_;
+    my $local_rename = shift(@{$renames});
+    (   $cfile,
+        $cfile,
+        $local_rename,
+        $local_rename,
+    );
+}
+
+# Select the files needed for the xxdiff (local rename, incoming rename)
+sub _cm_tree_conflict_get_graphic_sources_for_lrir {
+    my ($cfile, $keep_local, $renames) = @_;
+    my ($local_rename, $ext_rename) = @{$renames};
+    (   $cfile,
+        $ext_rename,
+        $local_rename,
+        ($keep_local ? $local_rename : $ext_rename),
+    );
+}
+
+# Return the actions needed to resolve 'local add, incoming add'
+sub _cm_tree_conflict_get_actions_for_laia {
+    my ($attrib_ref, $keep_local, $files_ref) = @_;
+    my ($cfile, $new_name) = @{$files_ref};
+    my ($url, $url_peg) = _cm_tree_conflict_source($attrib_ref, 'right', $cfile);
+    my ($basename) = basename($cfile);
+    my $cdir = dirname($cfile);
+    sub {
+        if (!$keep_local) {
+            my $content = $attrib_ref->{svn}->stdout(qw{svn cat}, $url);
+            $attrib_ref->{util}->file_save($cfile, $content);
+        }
+    };
+}
+
+
+# Return the actions needed to resolve 'local missing, incoming edit'
+sub _cm_tree_conflict_get_actions_for_ldie {
+    my ($attrib_ref, $keep_local, $files_ref) = @_;
+    my ($cfile) = @{$files_ref};
+    my ($url, $url_peg) = _cm_tree_conflict_source($attrib_ref, 'right', $cfile);
+    my $cdir = dirname($cfile);
+    sub {
+        if (!$keep_local) {
+            $attrib_ref->{svn}->call('copy', $url, "$cdir/");
+        }
+    };
+}
+
+# Return the actions needed to resolve 'local delete, incoming rename'
+sub _cm_tree_conflict_get_actions_for_ldir {
+    my ($attrib_ref, $keep_local, $files_ref) = @_;
+    my ($cfile, $ext_rename) = @{$files_ref};
+    sub {
+        if ($keep_local) {
+            $attrib_ref->{svn}->call('revert', $ext_rename);
+            unlink($ext_rename);
+        }
+    };
+}
+
+# Return the actions needed to resolve 'local edit, incoming delete'
+sub _cm_tree_conflict_get_actions_for_leid {
+    my ($attrib_ref, $keep_local, $files_ref) = @_;
+    my ($cfile) = @{$files_ref};
+    sub {
+        if (!$keep_local) {
+            $attrib_ref->{svn}->call('delete', $cfile);
+        }
+    };
+}
+
+# Return the actions needed to resolve 'local edit, incoming replace'
+sub _cm_tree_conflict_get_actions_for_leip {
+    my ($attrib_ref, $keep_local, $files_ref) = @_;
+    my ($cfile) = @{$files_ref};
+    my ($url, $url_peg) = _cm_tree_conflict_source($attrib_ref, 'right', $cfile);
+    my $cdir = dirname($cfile);
+    sub {
+        if (!$keep_local) {
+            $attrib_ref->{svn}->call('delete', $cfile);
+            $attrib_ref->{svn}->call('copy', $url, "$cdir/");
+        }
+    };
+}
+
+# Return the actions needed to resolve 'local edit, incoming rename'
+sub _cm_tree_conflict_get_actions_for_leir {
+    my ($attrib_ref, $keep_local, $files_ref) = @_;
+    my ($cfile, $ext_rename) = @{$files_ref};
+    sub {
+        if ($keep_local) {
+            $attrib_ref->{svn}->call('revert', $ext_rename);
+            unlink($ext_rename);
+        }
+        else {
+            $attrib_ref->{svn}->call('delete', $cfile);
+        }
+    };
+}
+
+# Return the actions needed to resolve 'local rename, incoming delete'
+sub _cm_tree_conflict_get_actions_for_lrid {
+    my ($attrib_ref, $keep_local, $files_ref) = @_;
+    my ($cfile, $lcl_rename) = @{$files_ref};
+    sub {
+        if (!$keep_local) {
+            $attrib_ref->{svn}->call('delete', $lcl_rename);
+        }
+    };
+}
+
+# Return the actions needed to resolve 'local rename, incoming edit'
+sub _cm_tree_conflict_get_actions_for_lrie {
+    my ($attrib_ref, $keep_local, $files_ref) = @_;
+    my ($cfile, $lcl_rename) = @{$files_ref};
+    sub {
+        if (!$keep_local) {
+            $attrib_ref->{svn}->call('rename', $lcl_rename, $cfile)
+        }
+    };
+}
+
+# Return the actions needed to resolve 'local rename, incoming rename'
+sub _cm_tree_conflict_get_actions_for_lrir {
+    my ($attrib_ref, $keep_local, $files_ref) = @_;
+    my ($cfile, $lcl_rename, $ext_rename) = @{$files_ref};
+    sub {
+        if ($keep_local) {
+            $attrib_ref->{svn}->call('revert', $ext_rename);
+            unlink($ext_rename);
+        }
+        else {
+            $attrib_ref->{svn}->call('delete', $lcl_rename);
+        }
+    };
+}
+
+# -----------------------------------------------------------------------------
+# Stores the identifier of the type of tree conflict.
+package FCM::System::CM::TreeConflictKey;
+use base qw{FCM::Class::HASH};
+
+# Creates the class.
+# 'local' is the local change (e.g. edit or delete),
+# 'incoming' is the external change (e.g. add or rename),
+# 'type' is one of merge, switch, or update.
+__PACKAGE__->class({'local' => '$', 'incoming' => '$', 'type' => '$'});
+
+# Returns a label string of the form LXIY e.g. LEID for local edit,
+# incoming delete.
+sub as_string {
+    my ($self) = shift();
+    my $local = $self->get_local() eq 'replace'
+        ? 'P' : uc(substr($self->get_local(), 0, 1));
+    my $incoming = $self->get_incoming() eq 'replace'
+        ? 'P' : uc(substr($self->get_incoming(), 0, 1));
+    sprintf('L%sI%s', $local, $incoming);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::CM::ResolveConflicts
+
+=head1 DESCRIPTION
+
+Part of L<FCM::System::CM|FCM::System::CM>.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM/SVN.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM/SVN.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/CM/SVN.pm	(revision 5095)
@@ -0,0 +1,1005 @@
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+#-------------------------------------------------------------------------------
+package FCM::System::CM::SVN;
+use base qw{FCM::Class::CODE};
+
+use Cwd qw{cwd};
+use FCM::Context::Event;
+use FCM::Context::Locator;
+use FCM::System::Exception;
+use Memoize qw{memoize};
+use File::Basename qw{dirname};
+use File::Spec::Functions qw{catfile rel2abs};
+use Time::Piece;
+use XML::Parser;
+
+my $E = 'FCM::System::Exception';
+
+# Settings for the default repository layout
+our %LAYOUT_CONFIG = (
+    'depth-project' => undef,
+    'depth-branch' => 3,
+    'depth-tag' => 1,
+    'dir-trunk' => 'trunk',
+    'dir-branch' => 'branches',
+    'dir-tag' => 'tags',
+    'level-owner-branch' => 2,
+    'level-owner-tag' => undef,
+    'owner' => undef,
+    'template-branch' => '{category}/{owner}/{name_prefix}{name}',
+    'template-tag' => undef,
+);
+
+# Layout configuration file basename
+our $LAYOUT_CFG_BASE = 'svn-repos-layout.cfg';
+
+# "svn log --xml" handlers.
+# -> element node start tag handlers
+my %SVN_LOG_ELEMENT_START_HANDLER_FOR = (
+#   tag        => handler
+    'logentry' => \&_get_log_handle_element_enter_logentry,
+    'path'     => \&_get_log_handle_element_enter_path,
+);
+# -> text node (after a start tag) handlers
+my %SVN_LOG_TEXT_HANDLER_FOR = (
+#   tag    => handler
+    'date' => \&_get_log_handle_text_date,
+    'path' => \&_get_log_handle_text_path,
+);
+
+our $SUBVERSION_SERVERS_CONF = catfile((getpwuid($<))[7], qw{.subversion/servers});
+
+my %ACTION_OF = (
+    'call'               => \&_call,
+    'get_info'           => \&_get_info,
+    'get_layout'         => \&_get_layout,
+    'get_layout_common'  => \&_get_layout_common,
+    'get_list'           => \&_get_list,
+    'get_log'            => \&_get_log,
+    'get_username'       => \&_get_username,
+    'get_wc_root'        => \&_get_wc_root,
+    'load_layout_config' => \&_load_layout_config,
+    'split_by_peg'       => \&_split_by_peg,
+    'stdout'             => \&_stdout,
+);
+
+# Creates the class.
+__PACKAGE__->class(
+    {   layout_cfg_base => {isa => '$', default => $LAYOUT_CFG_BASE},
+        layout_config_of=> '%',
+        util            => '&',
+    },
+    {action_of => \%ACTION_OF},
+);
+
+# Calls "svn".
+sub _call {
+    my ($attrib_ref, @args) = @_;
+    my @command = ('svn', @args);
+    my $timer = $attrib_ref->{util}->timer();
+    my $rc = system(@command);
+    $attrib_ref->{util}->event(
+        FCM::Context::Event->SHELL, \@command, $rc, $timer->());
+    if ($rc) {
+        $rc = $? == -1 ? $!
+            : $? & 127 ? $? & 127
+            :            $? >> 8
+            ;
+        return $E->throw($E->SHELL, {command_list => \@command, rc => $rc});
+    }
+    return;
+}
+
+# Invokes "svn info --xml @paths", and returns a LIST of info entries.
+memoize('_get_info');
+sub _get_info {
+    my $attrib_ref = shift();
+    my %option = ('recursive' => undef, 'revision' => undef);
+    if (@_ && ref($_[0]) && ref($_[0]) eq 'HASH') {
+        %option = (%option, %{shift()});
+    }
+    my @paths = @_;
+    if (!@paths) {
+        @paths = (q{.});
+    }
+    my (@entries, @stack);
+    my $parser = XML::Parser->new(Handlers => {
+        'Start' => sub {_get_info_handle_element_enter(\@entries, \@stack, @_)},
+        'End'   => sub {_get_info_handle_element_leave(\@entries, \@stack, @_)},
+        'Char'  => sub {_get_info_handle_text(         \@entries, \@stack, @_)},
+    });
+    $parser->parse(scalar(_stdout(
+        $attrib_ref,
+        qw{svn info --xml},
+        ($option{'recursive'} ? '--recursive' : ()),
+        ($option{'revision'} ? ('--revision', $option{'revision'}) : ()),
+        @paths,
+    )));
+    \@entries;
+}
+
+# Helper for _get_info. Handle the start tag of an XML element.
+sub _get_info_handle_element_enter {
+    my ($entries_ref, $stack_ref, $expat, $tag, %attrib) = @_;
+    # "entry": create a new entry in the list
+    if ($tag eq 'entry') {
+        push(@{$entries_ref}, {});
+    }
+    # "tree-conflict:version": need to handle differently
+    if (    $tag eq 'version'
+        &&  @{$stack_ref}
+        &&  $stack_ref->[-1] eq 'tree-conflict'
+    ) {
+        my (undef, undef, @names) = @{$stack_ref};
+        push(@names, delete($attrib{side}));
+        while (my ($key, $value) = each(%attrib)) {
+            my $name = join(':', @names, $key);
+            $entries_ref->[-1]->{$name} = delete($attrib{$key});
+        }
+    }
+    # Add current tag to stack
+    push(@{$stack_ref}, $tag);
+    # Add attributes to current entry, if appropriate
+    if (@{$entries_ref} && @{$stack_ref} >= 2 && %attrib) {
+        my (undef, undef, @names) = @{$stack_ref};
+        while (my ($key, $value) = each(%attrib)) {
+            my $name = join(':', @names, $key);
+            $entries_ref->[-1]->{$name} = $value;
+        }
+    }
+}
+
+# Helper for _get_info. Handle the end tag of an XML element.
+sub _get_info_handle_element_leave {
+    my ($entries_ref, $stack_ref, $expat, $tag) = @_;
+    pop(@{$stack_ref}) eq $tag;
+}
+
+# Helper for _get_info. Handle an XML text node.
+sub _get_info_handle_text {
+    my ($entries_ref, $stack_ref, $expat, $text) = @_;
+    if (@{$stack_ref} <= 2 || !@{$entries_ref} || $text eq "\n") {
+        return;
+    }
+    my (undef, undef, @names) = @{$stack_ref};
+    my $name = join(':', @names);
+    $entries_ref->[-1]->{$name} .= $text;
+}
+
+# Return an object containing the repository layout information of a URL.
+sub _get_layout {
+    my ($attrib_ref, $url_arg) = @_;
+    my %info = %{_get_info($attrib_ref, $url_arg)->[0]};
+    my ($url, $root, $peg_rev) = @info{'url', 'repository:root', 'revision'};
+    my $path = substr($url, length($root));
+    my $layout = _get_layout_common($attrib_ref, $root, $peg_rev, $path);
+    $layout->set_url($root . $path . '@' . $peg_rev);
+    $layout->set_username(_get_username($attrib_ref, $root));
+    $layout;
+}
+
+# Return an object containing the repository layout information of a URL.
+sub _get_layout_common {
+    my ($attrib_ref, $root, $rev, $path, $is_local) = @_;
+
+    my %layout_config = _load_layout_config(
+        $attrib_ref, ($is_local ? 'file://' . $root : $root),
+    );
+    my ($project, $branch, $category, $owner, $sub_tree);
+    my @names = split(qr{/+}msx, $path);
+    shift(@names); # element 1 should be an empty string
+
+    # Search for the project
+    my $depth = $layout_config{'depth-project'};
+    if (defined($depth)) {
+        if (@names >= $depth) {
+            my @project_names = ();
+            for (1 .. $layout_config{'depth-project'}) {
+                push(@project_names, shift(@names));
+            }
+            $project = join('/', @project_names);
+        }
+    }
+    elsif (!grep {!defined($layout_config{"dir-$_"})} qw{trunk branch tag}) {
+        # trunk, branches and tags are ALL in specific sub-directories under
+        # the project
+        my @dirs = map {$layout_config{"dir-$_"}} qw{trunk branch tag};
+        my @head = ();
+        my @tail = @names;
+        while (my $name = shift(@tail)) {
+            if (grep {$_ eq $name} @dirs) {
+                $project = join('/', @head);
+                @names = ($name, @tail);
+                last;
+            }
+            push(@head, $name);
+        }
+        if (!defined($project)) {
+            # $path does not contain the specific sub-directories that
+            # contain the trunk, branches and tags, but $path itself may be
+            # the project
+            my $target = $path . '/' . $layout_config{'dir-trunk'};
+            if (_verify_path($attrib_ref, $root, $rev, $target, $is_local)) {
+                $project = join('/', @names);
+            }
+            @names = ();
+        }
+    }
+    else {
+        # Can only assume that trunk is in a specific sub-directory under the
+        # project
+        my @head = ();
+        my @tail = @names;
+        while (my $name = shift(@tail)) {
+            if ($name eq $layout_config{'dir-trunk'}) {
+                $project = join('/', @head);
+                @names = ($name, @tail);
+                last;
+            }
+            push(@head, $name);
+        }
+        if (!defined($project)) {
+            # $path does not contain the trunk sub-directory, need to search
+            # for it
+            my @head = ();
+            my @tail = @names;
+            while (@head <= @names) {
+                my $target = join('/', @head, $layout_config{'dir-trunk'});
+                if (_verify_path($attrib_ref, $root, $rev, $target, $is_local)) {
+                    $project = join('/', @head);
+                    @names = @tail;
+                    last;
+                }
+                push(@head, shift(@tail));
+            }
+        }
+    }
+
+    # Search for the branch
+    if (defined($project) && @names) {
+        KEY:
+        for my $key (qw{trunk branch tag}) {
+            my @branch_names;
+            if ($layout_config{"dir-$key"}) {
+                if ($names[0] eq $layout_config{"dir-$key"}) {
+                    @branch_names = (shift(@names));
+                }
+                else {
+                    next KEY;
+                }
+            }
+            my $depth = $layout_config{"depth-$key"}
+                ? $layout_config{"depth-$key"} : 0;
+            if (@names >= $depth) {
+                for my $i (1 .. $depth) {
+                    my $name = shift(@names);
+                    push(@branch_names, $name);
+                    if (    $layout_config{"level-owner-$key"}
+                        &&  $layout_config{"level-owner-$key"} == $i
+                    ) {
+                        $owner = $name;
+                    }
+                }
+                $branch = join('/', @branch_names);
+                $category = $key;
+            }
+            last KEY;
+        }
+    }
+    # Remainder is the sub-tree under the branch
+    if (defined($branch)) {
+        $sub_tree = join('/', @names);
+    }
+    FCM::System::CM::SVN::Layout->new({
+        config          => \%layout_config,
+        root            => $root, 
+        path            => $path, 
+        peg_rev         => $rev,
+        project         => $project, 
+        branch          => $branch, 
+        branch_category => $category, 
+        branch_owner    => $owner, 
+        sub_tree        => $sub_tree,
+    });
+}
+
+# Return a (filtered) recursive listing of $url_arg.
+sub _get_list {
+    my ($attrib_ref, $url_arg, $filter_func) = @_;
+    my @list;
+    my ($url0, $rev) = _split_by_peg($attrib_ref, $url_arg);
+    my @items = ([$url0, 0]);
+    while (my $item = shift(@items)) {
+        my ($url, $depth) = @{$item};
+        ++$depth;
+        my @lines = _stdout($attrib_ref, qw{svn list}, $url . '@' . $rev);
+        for my $line (@lines) {
+            my ($this_name, $is_dir) = $line =~ qr{\A(.*?)(/?)\z};
+            my $this_url = $url . '/' . $this_name ;
+            my ($can_return, $can_recurse) = (1, $is_dir);
+            if (defined($filter_func)) {
+                ($can_return, $can_recurse)
+                    = $filter_func->($this_url, $this_name, $is_dir, $depth);
+            }
+            if ($can_return) {
+                push(@list, $this_url . '@' . $rev);
+            }
+            if ($can_recurse && $is_dir) {
+                push(@items, [$this_url, $depth]);
+            }
+        }
+    }
+    @list;
+}
+
+# Invokes "svn log --xml".
+sub _get_log {
+    my $attrib_ref = shift();
+    my %option = ('revision' => undef, 'stop-on-copy' => undef);
+    if (@_ && ref($_[0]) && ref($_[0]) eq 'HASH') {
+        %option = (%option, %{shift()});
+    }
+    my @paths = @_;
+    if (!@paths) {
+        @paths = (q{.});
+    }
+    my (@entries, @stack);
+    my $parser = XML::Parser->new(Handlers => {
+        'Start' => sub {_get_log_handle_element_enter(\@entries, \@stack, @_)},
+        'End'   => sub {_get_log_handle_element_leave(\@entries, \@stack, @_)},
+        'Char'  => sub {_get_log_handle_text(     \@entries, \@stack, @_)},
+    });
+    $parser->parse(scalar(_stdout(
+        $attrib_ref,
+        qw{svn log --xml -v},
+        ($option{'revision'} ? ('--revision', $option{'revision'}) : ()),
+        ($option{'stop-on-copy'} ? ('--stop-on-copy') : ()),
+        @paths,
+    )));
+    \@entries;
+}
+
+# Helper for "_get_log", handle beginning of an XML element.
+sub _get_log_handle_element_enter {
+    my ($entries_ref, $stack_ref, $expat, $tag, %attrib) = @_;
+    push(@{$stack_ref}, $tag);
+    if (exists($SVN_LOG_ELEMENT_START_HANDLER_FOR{$tag})) {
+        $SVN_LOG_ELEMENT_START_HANDLER_FOR{$tag}->(
+            $entries_ref,
+            $tag,
+            %attrib,
+        );
+    }
+}
+
+# Helper for "_get_log", handle beginning of the "logentry" element.
+sub _get_log_handle_element_enter_logentry {
+    my ($entries_ref, $tag, %attrib) = @_;
+    push(
+        @{$entries_ref},
+        {   'author'   => q{},
+            'date'     => q{},
+            'msg'      => q{},
+            'paths'    => [],
+            'revision' => $attrib{'revision'},
+        },
+    );
+}
+
+# Helper for "_get_log", handle beginning of the "path" element.
+sub _get_log_handle_element_enter_path {
+    my ($entries_ref, $tag, %attrib) = @_;
+    push(@{$entries_ref->[-1]->{'paths'}}, {%attrib, 'path' => q{}});
+}
+
+# Helper for "_get_log", handle end of an element.
+sub _get_log_handle_element_leave {
+    my ($entries_ref, $stack_ref, $expat, $tag) = @_;
+    pop(@{$stack_ref}) eq $tag;
+}
+
+# Helper for "_get_log", handle text node.
+sub _get_log_handle_text {
+    my ($entries_ref, $stack_ref, $expat, $text) = @_;
+    if (!exists($stack_ref->[-1])) {
+        return;
+    }
+    if (exists($SVN_LOG_TEXT_HANDLER_FOR{$stack_ref->[-1]})) {
+        $SVN_LOG_TEXT_HANDLER_FOR{$stack_ref->[-1]}->($entries_ref, $text);
+    }
+    elsif ( @{$entries_ref}
+        &&  exists($entries_ref->[-1]->{$stack_ref->[-1]})
+        &&  !ref($entries_ref->[-1]->{$stack_ref->[-1]})
+    ) {
+        $entries_ref->[-1]->{$stack_ref->[-1]} .= $text;
+    }
+}
+
+# Helper for "_get_log", handle text node in a "date" element.
+sub _get_log_handle_text_date {
+    my ($entries_ref, $text) = @_;
+    # "svn log --xml" may return a date with trailing spaces!
+    $text =~ s{\s+\z}{}gmsx;
+    my $head = Time::Piece->strptime(substr($text, 0, -8), '%Y-%m-%dT%H:%M:%S');
+    my $tail = substr($text, -8, -1);
+    $entries_ref->[-1]->{'date'} = $head->epoch() + $tail;
+}
+
+# Helper for "_get_log", handle text node in a "path" element.
+sub _get_log_handle_text_path {
+    my ($entries_ref, $text) = @_;
+    $entries_ref->[-1]->{'paths'}->[-1]->{'path'} .= $text;
+}
+
+# Return the username of the host of a given target URL.
+memoize('_get_username');
+sub _get_username {
+    my ($attrib_ref, $target) = @_;
+    my ($scheme, $sps) = $attrib_ref->{util}->uri_match($target);
+    my ($host) = $sps =~ qr{\A//([^/]+)(?:/|\z)}msx;
+    # Note: can use Config::IniFiles, but best to avoid another dependency.
+    # Note: not very efficient logic here, but should not yet matter.
+    my $subversion_servers_conf = exists($ENV{'FCM_SUBVERSION_SERVERS_CONF'})
+        ? $ENV{'FCM_SUBVERSION_SERVERS_CONF'} : $SUBVERSION_SERVERS_CONF;
+    my $handle
+        = $attrib_ref->{'util'}->file_load_handle($subversion_servers_conf);
+    my $is_in_section;
+    my $group;
+    LINE:
+    while (my $line = readline($handle)) {
+        chomp($line);
+        if ($line =~ qr{\A\s*(?:[#;]|\z)}msx) {
+            next LINE;
+        }
+        if ($line =~ qr{\A\s*\[\s*groups\s*\]\s*\z}msx) {
+            $is_in_section = 1;
+        }
+        elsif ($line =~ qr{\A\s*\[}msx) {
+            $is_in_section = 0;
+        }
+        elsif ($is_in_section) {
+            my ($lhs, $rhs) = $line =~ qr{\A\s*(\S+)\s*=\s*(\S+)\s*\z}msx;
+            if ($rhs) {
+                $rhs =~ s{[.]}{\\.}gmsx;
+                $rhs =~ s{[*]}{.*}gmsx;
+                $rhs =~ s{[?]}{.?}gmsx;
+                if ($host && $host =~ qr{\A$rhs\z}msx) {
+                    $group = $lhs;
+                    last LINE;
+                }
+            }
+        }
+    }
+    my $username = scalar(getpwuid($<)); # current user ID
+    if ($group) {
+        seek($handle, 0, 0);
+        LINE:
+        while (my $line = readline($handle)) {
+            chomp($line);
+            if ($line =~ qr{\A\s*(?:[#;]|\z)}msx) {
+                next LINE;
+            }
+            if ($line =~ qr{\A\s*\[\s*$group\s*\]\s*\z}msx) {
+                $is_in_section = 1;
+            }
+            elsif ($line =~ qr{\A\s*\[}msx) {
+                $is_in_section = 0;
+            }
+            elsif ($is_in_section) {
+                my ($rhs) = $line =~ qr{\A\s*username\s*=\s*(\S+)\s*\z}msx;
+                if ($rhs) {
+                    $username = $rhs;
+                    last LINE;
+                }
+            }
+        }
+    }
+    close($handle);
+    return $username;
+}
+
+# Return path to the root working copy directory of the argument.
+sub _get_wc_root {
+    my ($attrib_ref, $path) = @_;
+    $path ||= cwd();
+    my ($entries_ref) = _get_info($attrib_ref, $path);
+    if (    defined($entries_ref)
+        &&  @{$entries_ref}
+        &&  exists($entries_ref->[0]->{'wc-info:wcroot-abspath'})
+    ) {
+        return $entries_ref->[0]->{'wc-info:wcroot-abspath'};
+    }
+    if (-f $path) {
+        $path = dirname($path);
+    }
+    $path = rel2abs($path);
+    my $return;
+    if (-e catfile($path, qw{.svn entries})) {
+        while (   -e catfile($path, qw{.svn entries})
+               && $path ne dirname($path)
+        ) {
+            $return = $path;
+            $path = dirname($path);
+        }
+    }
+    else {
+        while (   !-e catfile($path, qw{.svn entries})
+               && $path ne dirname($path)
+        ) {
+            $path = dirname($path);
+            $return = $path;
+        }
+    }
+    return $return;
+}
+
+# Load layout related configuration for a given URL root.
+memoize('_load_layout_config');
+sub _load_layout_config {
+    my ($attrib_ref, $root) = @_;
+    if (exists($attrib_ref->{layout_config_of}{$root})) {
+        return %{$attrib_ref->{layout_config_of}{$root}};
+    }
+    my %site_layout_config;
+    if (exists($attrib_ref->{layout_config_of}{q{}})) {
+        %site_layout_config = %{$attrib_ref->{layout_config_of}{q{}}};
+    }
+    else {
+        %site_layout_config = %LAYOUT_CONFIG;
+        $attrib_ref->{util}->cfg_init(
+            $attrib_ref->{layout_cfg_base},
+            sub {
+                my $config_reader = shift();
+                my @unknown_entries;
+                while (defined(my $entry = $config_reader->())) {
+                    if (exists($site_layout_config{$entry->get_label()})) {
+                        my $value
+                            = $entry->get_value() ? $entry->get_value() : undef;
+                        $site_layout_config{$entry->get_label()} = $value;
+                    }
+                    else {
+                        push(@unknown_entries, $entry);
+                    }
+                }
+                if (@unknown_entries) {
+                    return $E->throw($E->CONFIG_UNKNOWN, \@unknown_entries);
+                }
+            },
+        );
+        $attrib_ref->{layout_config_of}{q{}} = {%site_layout_config};
+    }
+    $attrib_ref->{layout_config_of}{$root} = {%site_layout_config};
+    my @prop_lines = eval {
+        _stdout($attrib_ref, qw{svn propget fcm:layout}, $root);
+    };
+    if ($@) {
+        $@ = undef;
+    }
+    PROP_LINE:
+    while (defined(my $prop_line = shift(@prop_lines))) {
+        chomp($prop_line);
+        if ($prop_line =~ qr{\A\s*(?:\#|\z)}msx) { # comment line
+            next PROP_LINE;
+        }
+        ($prop_line) = $prop_line =~ qr{\A\s*(.+?)\s*\z}msx; # trim
+        my ($key, $value) = split(qr{\s*=\s*}msx, $prop_line, 2);
+        if (exists($attrib_ref->{layout_config_of}{$root}{$key})) {
+            $attrib_ref->{layout_config_of}{$root}{$key} = $value;
+        }
+    }
+    %{$attrib_ref->{layout_config_of}{$root}};
+}
+
+# Splits a URL@REV by the @.
+sub _split_by_peg {
+    my ($attrib_ref, $url) = @_;
+    $url =~ qr{\A(.*?)(?:@([^@/]+))?\z}msx;
+}
+
+# Calls "svn", return its standard output.
+sub _stdout {
+    my ($attrib_ref, @command) = @_;
+    my %value_of = %{$attrib_ref->{util}->shell_simple(\@command)};
+    if ($value_of{rc}) {
+        return $E->throw(
+            $E->SHELL,
+            {command_list => \@command, %value_of},
+            $value_of{e}
+        );
+    }
+    wantarray() ? split("\n", $value_of{o}) : $value_of{o};
+}
+
+# Return true if $path is in $repos for this $rev
+sub _verify_path {
+    my ($attrib_ref, $root, $rev, $path, $is_local) = @_;
+    if ($is_local) {
+        my $opt = $rev =~ qr{\A\d+\z}msx ? '-r' : '-t';
+        eval {
+            _stdout($attrib_ref, qw{svnlook tree -N}, $opt, $rev, $root, $path);
+        };
+        if ($@) {
+            $@ = q{};
+            return;
+        }
+        return ($root, $rev, $path);
+    }
+    else {
+        my $target = $root . '/' . $path . '@' . $rev;
+        my $url = eval {_get_info($attrib_ref, $target)->[0]->{url}};
+        if ($@ || !$url) {
+            $@ = q{};
+            return;
+        }
+        return ($root, $rev, $path);
+    }
+}
+
+#-------------------------------------------------------------------------------
+# Represent the layout information of a Subversion URL.
+package FCM::System::CM::SVN::Layout;
+use base qw{FCM::Class::HASH};
+
+__PACKAGE__->class({
+    config          => '%',
+    url             => '$',
+    root            => '$',
+    path            => '$',
+    peg_rev         => '$',
+    project         => '$',
+    branch          => '$',
+    branch_category => '$',
+    branch_owner    => '$',
+    sub_tree        => '$',
+    username        => {isa => '$', default => scalar(getpwuid($<))},
+});
+
+sub is_trunk {
+    $_[0]->{branch_category} && $_[0]->{branch_category} eq 'trunk';
+}
+
+sub is_branch {
+    $_[0]->{branch_category} && $_[0]->{branch_category} eq 'branch';
+}
+
+sub is_tag {
+    $_[0]->{branch_category} && $_[0]->{branch_category} eq 'tag';
+}
+
+sub is_owned_by_user {
+    my ($self, $user) = @_;
+    $user ||= $self->get_username();
+    $self->{branch_owner} && $self->{branch_owner} eq $user;
+}
+
+sub is_shared {
+    my ($self) = @_;
+    $self->{branch_owner}
+        && grep {$_ eq $self->{branch_owner}} qw{Share Config Rel};
+}
+
+sub as_string {
+    my ($self) = @_;
+    my $return = q{};
+    for my $key (qw{
+        url
+        root
+        path
+        peg_rev
+        project
+        branch
+        branch_category
+        branch_owner
+        sub_tree
+    }) {
+        my $value = $self->{$key};
+        if ($key ne 'config' && defined($value)) {
+            $return .= "$key: $value\n";
+        }
+    }
+    return $return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::CM::SVN
+
+=head1 DESCRIPTION
+
+Part of L<FCM::System::CM|FCM::System::CM>. Provides an interface for common SVN
+functionalities used in the FCM CM sub-system.
+
+=head1 METHODS
+
+This is a sub-class of L<FCM::Class::CODE|FCM::Class::CODE>.
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Return a new instance of this class. %attrib accepts a single "util" key for an
+instance of an L<FCM::Util|FCM::Util> object.
+
+=item $instance->call(@args)
+
+Call the command line "svn" with a list of arguments in @args.
+
+=item $instance->get_info(@path)
+=item $instance->get_info(\%option, @path)
+
+Invokes "svn info --xml @paths", and returns a LIST of info entries. If @paths
+is not specified, use ("."). If %option is specified, it may contain the keys:
+
+=over 4
+
+=item recursive
+
+If value of this key is not undef, add --recursive to "svn info".
+
+=item revision
+
+If value of this key is not undef, add --revision VALUE to "svn info".
+
+=back
+
+Each info entry is a HASH with keys reflecting the tag or attribute name in an
+entry element. The original hierarchy below the entry element is delimited by a
+colon in the name. For example, a return structure may look like this:
+    [   {   'commit:author' => 'fred',
+            'commit:date' => '2011-11-09T15:41:14.514665Z',
+            'commit:revision' => '4549',
+            'kind' => 'dir',
+            'path' => 'trunk',
+            'revision' => '4552',
+            'repository:root' => 'svn://host/my-repos',
+            'repository:uuid' => '91f685bf-fbee-0310-99e6-f3aa9e660bd5'
+            'url' => 'svn://host/my-repos/FCM/trunk',
+        },
+    ]
+
+=item $instance->get_layout($url)
+
+Return an instance of L<FCM::System::CM::SVN::Layout|/FCM::System::CM::SVN::Layout>
+containing the repository layout information of $url.
+
+=item $instance->get_layout_common($root, $rev, $path, $is_local)
+
+Return an instance of L<FCM::System::CM::SVN::Layout|/FCM::System::CM::SVN::Layout>
+containing the repository layout information for $path in $root at $rev. If
+$is_local is true, use "svnlook" to verify the existence of $path in $root
+at $rev. Otherwise, it uses "svn info" instead. If $rev is assumed to be a
+transaction if it is not numeric.
+
+=item $instance->get_list($url_arg, $filter_func)
+
+Call "svn list" multiple times to obtain a recursive listing of files and
+directories under $url_arg. Return a list containing the listing. If
+$filter_func is defined, it should be a CODE reference, which would be invoked
+for each file/directory found. It should have the interface:
+
+    ($can_return, $can_recurse)
+        = $filter_func->($this_url, $this_name, $is_dir, $depth);
+
+where $this_url is the URL of the file/directory found, $this_name is the
+base name of the file/directory found, $is_dir is true if it is a directory,
+$depth is the directory depth of $this_url relative to $url_arg.
+
+The $filter_func CODE reference should return a 2-element list ($can_return,
+$can_recurse). The get_list method will only return $this_url in the listing
+if $can_return is set to true. If $is_dir is true and $can_recurse is true, the
+get_list method will go down to do more listing in $this_url.
+
+=item $instance->get_log(@path)
+=item $instance->get_log(\%option, @path)
+
+Invokes "svn log --xml".  If @paths is not specified, use ("."). If %option is
+specified, it may contain the keys:
+
+=over 4
+
+=item revision
+
+If value of this key is not undef, add --revision VALUE to "svn log".
+
+=item stop-on-copy
+
+If value of this key is not undef, add --stop-on-copy to "svn log".
+
+=back
+
+Returns an ARRAY reference. Each element is a data structure that represents a
+log entry. The data structure should look like:
+    [   {   'author'   => $author,
+            'date'     => $date, # seconds since epoch
+            'msg'      => $msg,
+            'paths'    => [
+                {   'path'          => $path,
+                    'action'        => $action,
+                    'copyfrom-path' => $p,
+                    'copyfrom-rev'  => $r,
+                },
+                # ...
+            ],
+            'revision' => $revision,
+        },
+    ]
+
+=item $instance->get_username($target)
+
+Return the user name associated with $target.
+
+=item $instance->get_wc_root($path)
+
+Return the path to the root working copy directory of the argument.
+
+=item $instance->load_layout_config($root)
+
+Return a HASH (not a reference) containing the layout configuration of $root.
+See %LAYOUT_CONFIG for default settings. $root should be the URL to a
+repository root.
+
+=item $instance->split_by_peg($location)
+
+Split a location string (either a URL@PEG or a PATH@PEG) and return a
+two-element list: either (URL, PEG) or (PATH, PEG).
+
+=item $instance->stdout(@command)
+
+Call a @command, capture and return the STDOUT on success. In scalar context,
+return the STDOUT as-is. In array context, return it as a list of lines with the
+new line characters removed.
+
+=back
+
+=head1 EXCEPTION
+
+Methods in this class may throw an
+L<FCM::System::Exception|FCM::System::Exception> on error.
+
+=head1 FCM::System::CM::SVN::Layout
+
+The FCM::System::CM::SVN::Layout class inherits from
+L<FCM::Class::HASH|FCM::Class::HASH>. An instance represents the layout
+information in a Subversion URL based on the default or specified FCM layout
+information. It has the following attributes:
+
+=over 4
+
+=item config
+
+is a HASH containing the layout configuration applied to this URL.
+Valid keys and their default values are:
+
+=over 4
+
+=item depth-project => undef
+Number of sub-directories used by the name of a project.
+
+=item depth-branch => 3
+Number of sub-directories (under "branches") used by the name of branch.
+
+=item depth-tag => 1
+Number of sub-directories (under "tags") used by the name of branch.
+
+=item dir-trunk => 'trunk'
+Name of the master/trunk directory.
+
+=item dir-branch => 'branches'
+Name of the directory where all branches live. May be empty.
+
+=item dir-tag => 'tags'
+Name of the directory where all tags live. May be empty.
+
+=item level-owner-branch => 2
+Sub-directory level in the name of a branch containing the its owner.
+
+=item level-owner-branch => undef
+Sub-directory level in the name of a tag containing the its owner.
+
+=item template-branch => '{category}/{owner}/{name_prefix}{name}'
+Branch name template.
+
+=item template-tag => undef
+Tag name template.
+
+=back
+
+=item url
+
+is the full URL@PEG.
+
+=item root
+
+is the repository root.
+
+=item path
+
+is the path below the repository root.
+
+=item peg_rev
+
+is the (peg) revision of the URL.
+
+=item project
+
+is the project name in the URL. It is undef if the URL does not contain a valid
+project name for the given repository. An empty string is possible, for example,
+if the layout means that the trunk is at the root level.
+
+=item branch
+
+is the "branch" name in the URL, (which may be the name of the master/trunk
+branch or the name of a tag). It is undef if the URL does not contain a valid
+branch name for the given repository.
+
+=item branch_category
+
+is the category (i.e. "trunk", "branch" or "tag") of the branch.
+
+=item branch_owner
+
+is the owner of the branch, if it can be derived from the URL.
+
+=item sub_tree
+
+is the path in the URL under the branch of a project tree. It is undef if the
+URL is not at or below the level of a branch of the project tree. An empty
+string means the that the URL is at root level of the project tree.
+
+=back
+
+An FCM::System::CM::SVN::Layout instance has the following convenient methods:
+
+=over 4
+
+=item $layout->is_trunk()
+
+The URL is in the trunk of a project.
+
+=item $layout->is_branch()
+
+The URL is in a branch of a project.
+
+=item $layout->is_tag()
+
+The URL is in a tag of a project.
+
+=item $layout->is_owned_by_user($user)
+
+The URL is in a branch owned by $user. If $user is not defined, it defaults to
+the current user ID.
+
+=item $layout->is_shared()
+
+The URL is in a shared branch.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Exception.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Exception.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Exception.pm	(revision 5095)
@@ -0,0 +1,428 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package FCM::System::Exception;
+use base qw{FCM::Exception};
+use Scalar::Util qw{blessed};
+
+use constant {
+    BUILD_SOURCE     => 'BUILD_SOURCE',
+    BUILD_SOURCE_SYN => 'BUILD_SOURCE_SYN',
+    BUILD_TARGET     => 'BUILD_TARGET',
+    BUILD_TARGET_BAD => 'BUILD_TARGET_BAD',
+    BUILD_TARGET_CYC => 'BUILD_TARGET_CYC',
+    BUILD_TARGET_DEP => 'BUILD_TARGET_DEP',
+    BUILD_TARGET_DUP => 'BUILD_TARGET_DUP',
+    CACHE_LOAD       => 'CACHE_LOAD',
+    CACHE_TYPE       => 'CACHE_TYPE',
+    CM_ALREADY_EXIST => 'CM_ALREADY_EXIST',
+    CM_ARG           => 'CM_ARG',
+    CM_BRANCH_NAME   => 'CM_BRANCH_NAME',
+    CM_BRANCH_SOURCE => 'CM_BRANCH_SOURCE',
+    CM_CHECKOUT      => 'CM_CHECKOUT',
+    CM_LOG_EDIT_DELIMITER => 'CM_LOG_EDIT_DELIMITER',
+    CM_LOG_EDIT_NULL => 'CM_LOG_EDIT_NULL',
+    CM_OPT_ARG       => 'CM_OPT_ARG',
+    CM_PROJECT_NAME  => 'CM_PROJECT_NAME',
+    CM_REPOSITORY    => 'CM_REPOSITORY',
+    CONFIG_CONFLICT  => 'CONFIG_CONFLICT',
+    CONFIG_INHERIT   => 'CONFIG_INHERIT',
+    CONFIG_MODIFIER  => 'CONFIG_MODIFIER',
+    CONFIG_NS        => 'CONFIG_NS',
+    CONFIG_NS_VALUE  => 'CONFIG_NS_VALUE',
+    CONFIG_UNKNOWN   => 'CONFIG_UNKNOWN',
+    CONFIG_VALUE     => 'CONFIG_VALUE',
+    CONFIG_VERSION   => 'CONFIG_VERSION',
+    COPY             => 'COPY',
+    DEST_CLEAN       => 'DEST_CLEAN',
+    DEST_CREATE      => 'DEST_CREATE',
+    DEST_LOCKED      => 'DEST_LOCKED',
+    EXPORT_ITEMS_SRC => 'EXPORT_ITEMS_SRC',
+    EXTRACT_LOC_BASE => 'EXTRACT_LOC_BASE',
+    EXTRACT_MERGE    => 'EXTRACT_MERGE',
+    EXTRACT_NS       => 'EXTRACT_NS',
+    MIRROR           => 'MIRROR',
+    MIRROR_NULL      => 'MIRROR_NULL',
+    MIRROR_SOURCE    => 'MIRROR_SOURCE',
+    MIRROR_TARGET    => 'MIRROR_TARGET',
+    MAKE             => 'MAKE',
+    MAKE_ARG         => 'MAKE_ARG',
+    MAKE_CFG         => 'MAKE_CFG',
+    MAKE_CFG_FILE    => 'MAKE_CFG_FILE',
+    MAKE_PROP_NS     => 'MAKE_PROP_NS',
+    MAKE_PROP_VALUE  => 'MAKE_PROP_VALUE',
+    SHELL            => 'SHELL',
+};
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Exception
+
+=head1 SYNOPSIS
+
+    eval {
+        # ...
+        FCM::System::Exception->throw($code, $ctx);
+        # ...
+        FCM::System::Exception->throw($code, $ctx, {exception => $e});
+        # ...
+    };
+    if (my $e = $@) {
+        if (FCM::System::Exception->caught($e)) {
+            # do something ...
+        }
+        else {
+            # do something else ...
+        }
+    }
+
+=head1 DESCRIPTION
+
+This exception represents an error condition in an FCM sub-system. It is a
+sub-class of L<FCM::Exception|FCM::Exception>.
+
+=head1 CONSTANTS
+
+The following are known error code:
+
+=over 4
+
+=item FCM::System::Exception->BUILD_SOURCE
+
+The build sub-system fails because a specified source does not exist. Expects
+$e->get_ctx() to return the source path.
+
+=item FCM::System::Exception->BUILD_SOURCE_SYN
+
+The build sub-system fails because a specified source has a syntax error.
+Expects $e->get_ctx() to return an ARRAY reference containing the source path
+and the line number where the error occurs.
+
+=item FCM::System::Exception->BUILD_TARGET
+
+The build sub-system fails because a target does not exist when it is supposed
+to be updated. Expects $e->get_ctx() to return an instance of
+L<FCM::Context::Make::Build::Target|FCM::Context::Make::Build/FCM::Context::Make::Build::Target>.
+
+=item FCM::System::Exception->BUILD_TARGET_BAD
+
+The build sub-system fails because the user has specified invalid targets.
+Expects $e->get_ctx() to return an ARRAY reference of the bad target keys.
+
+=item FCM::System::Exception->BUILD_TARGET_CYC
+
+The build sub-system fails due to cyclic dependency in a target. Expects
+$e->get_ctx() to return a HASH {$key => {'keys' => \@stack}, ...}, where each
+$key is the ID of a problematic target and the @stack is an ARRAY reference of a
+stack of target keys where the problem is detected.
+
+=item FCM::System::Exception->BUILD_TARGET_DEP
+
+The build sub-system fails because some targets have missing dependencies.
+Expects $e->get_ctx() to return a HASH
+{$key => {'keys' => \@stack, 'values' => [$dep_key, $dep_type]}, ...}, where each
+$key is the ID of a problematic target, the @stack is an ARRAY reference of a
+stack of target keys where the problem is detected, and the
+[$dep_key, $dep_type] ARRAY contains the key and type of the dependency.
+
+=item FCM::System::Exception->BUILD_TARGET_DUP
+
+The build sub-system fails because there are multiple versions of a build
+target. Expects $e->get_ctx() to return a HASH
+{$key => {'keys' => \@stack, 'values' => \@ns}, ...} where each $key is the ID of a
+problematic target, the @stack is an ARRAY
+reference of a stack of target keys where the problem is detected,
+and @ns contains the name-spaces of the sources that give the same target key.
+
+=item FCM::System::Exception->CACHE_LOAD
+
+The system is unable to load a cache from a make destination. Expects
+$e->get_ctx() to return the path it fails to load; and the $e->get_exception()
+to return the original exception that triggers this failure.
+
+=item FCM::System::Exception->CACHE_TYPE
+
+The system loaded a cache into a data structure, but the data structure is not
+the expected object type. Expects $e->get_ctx() to return the path to the cache.
+
+=item FCM::System::Exception->CM_ALREADY_EXIST
+
+Attempt to create a target that already exists. Expects $e->get_ctx() to return the
+target URL.
+
+=item FCM::System::Exception->CM_ARG
+
+Attempt to supply a bad argument. Expects $e->get_ctx() to return the bad value.
+
+=item FCM::System::Exception->CM_BRANCH_NAME
+
+Attempt to create a branch with a bad name. Expects $e->get_ctx() to return the
+bad name.
+
+=item FCM::System::Exception->CM_BRANCH_SOURCE
+
+Attempt to create a branch with an invalid source. Expects $e->get_ctx() to
+return the source.
+
+=item FCM::System::Exception->CM_CHECKOUT
+
+Attempt to checkout to an existing working copy. Expects $e->get_ctx() to return
+an ARRAY containing the target path and the URL it is pointing to.
+
+=item FCM::System::Exception->CM_LOG_EDIT_DELIMITER
+
+The commit message delimiter is modified after an edit.
+
+=item FCM::System::Exception->CM_LOG_EDIT_NULL
+
+The commit message is empty after an edit.
+
+=item FCM::System::Exception->CM_OPT_ARG
+
+Attempt to supply a bad argument to a valid option. Expects $e->get_ctx() to
+return the option key and the bad value.
+
+=item FCM::System::Exception->CM_PROJECT_NAME
+
+Attempt to create a project with a bad name. Expects $e->get_ctx() to return the
+bad name.
+
+=item FCM::System::Exception->CM_REPOSITORY
+
+Attempt to access an invalid repository. Expects $e->get_ctx() to return the
+bad repository.
+
+=item FCM::System::Exception->CONFIG_CONFLICT
+
+In a make configuration file, a declaration attempts to modify a value that is
+inherited from a previous make, and considered read-only. Expects $e->get_ctx()
+to return a L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry> object.
+
+=item FCM::System::Exception->CONFIG_INHERIT
+
+In a make configuration file, a declaration attempts to inherit from a make that
+is either incomplete or failed. Expects $e->get_ctx() to return a
+L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry> object.
+
+=item FCM::System::Exception->CONFIG_MODIFIER
+
+In a make configuration file, a modifier of in a declaration is incorrect.
+Expects $e->get_ctx() to return a
+L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry> object and
+$e->get_exception() to return (if any) the original exception that triggers this
+failure.
+
+=item FCM::System::Exception->CONFIG_NS
+
+In a make configuration file, a declaration is missing a required name-space, or
+the name-space declaration is incorrect. Expects $e->get_ctx() to return a
+L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry> object and
+$e->get_exception() to return (if any) the original exception that triggers this
+failure.
+
+=item FCM::System::Exception->CONFIG_NS_VALUE
+
+In a make configuration file, the name-space of a declaration is incompatible
+with the value. (E.g. the number of name-space elements does not match with the
+number of words in a value.) Expects $e->get_ctx() to return a
+L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry> object and
+$e->get_exception() to return (if any) the original exception that triggers this
+failure.
+
+=item FCM::System::Exception->CONFIG_UNKNOWN
+
+In a make configuration file, the label of a declaration is unrecognised by the
+system. Expects $e->get_ctx() to return a reference to an ARRAY containing
+L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry> objects.
+
+=item FCM::System::Exception->CONFIG_VALUE
+
+In a make configuration file, the value of a declaration is incorrect. Expects
+$e->get_ctx() to return a L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry>
+object and $e->get_exception() to return (if any) the original exception that
+triggers this failure.
+
+=item FCM::System::Exception->CONFIG_VERSION
+
+A make configuration file requires certain version of FCM. Expects
+$e->get_ctx() to return a L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry>
+object, and the current FCM version.
+
+=item FCM::System::Exception->COPY
+
+The system fails to perform a file copy. Expects $e->get_ctx() to return a
+2-element ARRAY reference to represent the source and the target, and the
+$e->get_exception() to return the original exception that triggers this failure.
+
+=item FCM::System::Exception->DEST_CLEAN
+
+A destination path cannot be removed. Expects $e->get_ctx() to return the path
+that the system fails to remove, and $e->get_exception() to return the original
+exception that triggers this failure.
+
+=item FCM::System::Exception->DEST_CREATE
+
+The system is unable to create a path at a make destination. Expects
+$e->get_ctx() to return the path it fails to create; and the $e->get_exception()
+to return the original exception that triggers this failure.
+
+=item FCM::System::Exception->DEST_LOCKED
+
+A lock file exists at the destination. Expects $e->get_ctx() to return the
+path to the lock file.
+
+=item FCM::System::Exception->EXPORT_ITEMS_SRC
+
+The system fails because the source location is not specified.
+
+=item FCM::System::Exception->EXTRACT_LOC_BASE
+
+The system fails to determine the location of a base tree of a project. Expects
+$e->get_ctx() to return the name-space of the project.
+
+=item FCM::System::Exception->EXTRACT_MERGE
+
+The system fails to merge the sources of an extract target. Expects
+$e->get_ctx() to return a HASH reference with the following keys:
+
+=over 4
+
+=item target
+
+The FCM::Context::Make::Extract::Target object associated with this failure.
+
+=item output
+
+The path to a file containing the failed merge output.
+
+=item keys_done
+
+The keys of the source trees providing the source files for this target that
+have already been merged.
+
+=item key
+
+The key of the source tree providing the source file for this target that causes
+the merge conflict.
+
+=item keys_left
+
+The keys of the source trees providing the source files for this target that are
+yet to be merged.
+
+=back
+
+=item FCM::System::Exception->EXTRACT_NS
+
+The system fails because there are some extract declarations for the name-spaces
+but the settings are not used. Expects $e->get_ctx() to return an ARRAY of bad
+name-spaces.
+
+=item FCM::System::Exception->MIRROR
+
+The mirror operation failed. Expects $e->get_ctx() to return a reference of a
+2-element ARRAY containing the source and the target of the mirror, and
+$e->get_exception() to return the original exception that triggers this failure.
+
+=item FCM::System::Exception->MIRROR_NULL
+
+The mirror step failed because a target is not specified. The $e->get_ctx() is
+undefined.
+
+=item FCM::System::Exception->MIRROR_SOURCE
+
+The mirror step failed because the destination of a completed step in the make
+is not suitable for mirroring. Expects $e->get_ctx() to return an ARRAY
+reference containing the names of the unsuitable steps.
+
+=item FCM::System::Exception->MIRROR_TARGET
+
+The mirror step failed to create the target. Expects $e->get_ctx() to
+return the target of the mirror, and $e->get_exception() to return the original
+exception that triggers this failure.
+
+=item FCM::System::Exception->MAKE
+
+A named step in a make is not implemented. Expects $e->get_ctx() to return the
+name of the step.
+
+=item FCM::System::Exception->MAKE_ARG
+
+A make sub-system fails because of bad command line arguments. Expects
+$e->get_ctx() to return an ARRAY reference of something like this:
+
+    my @list = @{$e->get_ctx()};
+    for (@list) {
+        my ($arg_index, $arg) = @{$_};
+        warn("Argument $arg_index ($arg) is invalid\n");
+    }
+
+=item FCM::System::Exception->MAKE_CFG
+
+A make sub-system fails because it can find no configuration.
+
+=item FCM::System::Exception->MAKE_CFG_FILE
+
+A make sub-system fails because it cannot file a named configuration file.
+Expects $e->get_ctx() to return the configuration file name.
+
+=item FCM::System::Exception->MAKE_PROP_NS
+
+A make sub-system fails because a property is specified with an invalid
+name-space. Expects $e->get_ctx() to return an ARRAY reference of something like
+this:
+
+    my @list = @{$e->get_ctx()};
+    for (@list) {
+        my ($step_name, $prop_name, $ns, $value) = @{$_};
+        warn("{$prop_name}[$ns]: prop ns is invalid\n");
+    }
+
+=item FCM::System::Exception->MAKE_PROP_VALUE
+
+A make sub-system fails because a property is specified with an invalid
+value. Expects $e->get_ctx() to return an ARRAY reference of something like
+this:
+
+    my @list = @{$e->get_ctx()};
+    for (@list) {
+        my ($step_name, $prop_name, $ns, $value) = @{$_};
+        warn("{$prop_name}[$ns] = $value: prop value is bad\n");
+    }
+
+=item FCM::System::Exception->SHELL
+
+A shell command returns an error. Expects $e->get_ctx() to return a HASH
+reference containing {command_list}, an ARRAY reference representing the
+command; {rc}, the return code; {out}, the standard output of the command and
+{err}, the standard error of the command. Expects $e->get_exception() to return
+the standard error of the command.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make.pm	(revision 5095)
@@ -0,0 +1,452 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::ConfigEntry;
+use FCM::Context::Event;
+use FCM::System::Exception;
+use FCM::System::Make::Build;
+use FCM::System::Make::Extract;
+use FCM::System::Make::Mirror;
+use FCM::System::Make::Preprocess;
+use FCM::System::Make::Share::Config;
+use FCM::System::Make::Share::Dest;
+use File::Basename qw{basename};
+use File::Copy qw{copy};
+use File::Path qw{rmtree};
+use File::Spec::Functions qw{catfile};
+use File::Temp;
+use POSIX qw{strftime};
+use Sys::Hostname qw{hostname};
+
+# Actions of the named common steps
+my %ACTION_OF = (
+    'config-parse' => \&_config_parse,
+    'dest-init'    => \&_dest_init   ,
+);
+# Alias to class name
+my $E = 'FCM::System::Exception';
+# The initial steps to run
+my @INIT_STEPS = (qw{config-parse dest-init});
+# The name of the system
+our $NAME = 'make';
+# Base name of common configuration file
+our $CFG_BASE = 'make.cfg';
+# A map of named helper utilities
+our %SHARED_UTIL_OF = (
+    'config' => 'FCM::System::Make::Share::Config',
+    'dest'   => 'FCM::System::Make::Share::Dest'  ,
+);
+# A map of named subsystems
+our %SUBSYSTEM_OF = (
+    'build'      => 'FCM::System::Make::Build'     ,
+    'extract'    => 'FCM::System::Make::Extract'   ,
+    'mirror'     => 'FCM::System::Make::Mirror'    ,
+    'preprocess' => 'FCM::System::Make::Preprocess',
+);
+
+# Creates the class.
+__PACKAGE__->class(
+    {   cfg_base       => {isa => '$', default => $CFG_BASE},
+        name           => {isa => '$', default => $NAME},
+        shared_util_of => '%',
+        subsystem_of   => '%',
+        util           => '&',
+    },
+    {init => \&_init, action_of => {main => \&_main}},
+);
+
+# Initialises an instance.
+sub _init {
+    my $attrib_ref = shift();
+    for (
+        ['shared_util_of', \%SHARED_UTIL_OF],
+        ['subsystem_of'  , \%SUBSYSTEM_OF  ],
+    ) {
+        my ($key, $hash_ref) = @{$_};
+        while (my ($id, $class) = each(%{$hash_ref})) {
+            if (!exists($attrib_ref->{$key}{$id})) {
+                $attrib_ref->{$key}{$id} = $class->new({
+                    'shared_util_of' => $attrib_ref->{'shared_util_of'},
+                    'subsystem_of'   => $attrib_ref->{'subsystem_of'},
+                    'util'           => $attrib_ref->{'util'},
+                });
+            }
+        }
+    }
+    $attrib_ref->{util}->cfg_init(
+        $attrib_ref->{cfg_base},
+        sub {
+            my $config_reader = shift();
+            my @unknown_entries;
+            while (defined(my $entry = $config_reader->())) {
+                my ($id, $label) = split(qr{\.}msx, $entry->get_label(), 2);
+                if (exists($attrib_ref->{subsystem_of}{$id})) {
+                    my $subsystem = $attrib_ref->{subsystem_of}{$id};
+                    if (!$subsystem->config_parse_class_prop($entry, $label)) {
+                        push(@unknown_entries, $entry);
+                    }
+                }
+                else {
+                    push(@unknown_entries, $entry);
+                }
+            }
+            if (@unknown_entries) {
+                return $E->throw($E->CONFIG_UNKNOWN, \@unknown_entries);
+            }
+        },
+    );
+}
+
+# Sets up the destination.
+sub _config_parse {
+    my ($attrib_ref, $m_ctx, @args) = @_;
+    my $entry_callback_ref = sub {
+        my ($entry) = @_;
+        print({$attrib_ref->{handle_cfg}} $entry->as_string(), "\n");
+    };
+    $attrib_ref->{shared_util_of}{config}->parse(
+        $entry_callback_ref, $m_ctx, @args,
+    );
+}
+
+# Sets up the destination.
+sub _dest_init {
+    my ($attrib_ref, $m_ctx) = @_;
+    my $DEST_UTIL = $attrib_ref->{shared_util_of}{dest};
+    $DEST_UTIL->dest_init($m_ctx);
+
+    # Move temporary log file to destination
+    my $now = strftime("%Y%m%dT%H%M%S", gmtime());
+    my $log = $DEST_UTIL->path($m_ctx, 'sys-log');
+    my $log_actual = sprintf("%s-%s", $log, $now);
+    _symlink(basename($log_actual), $log);
+    (       close($attrib_ref->{handle_log})
+        &&  copy($attrib_ref->{handle_log}->filename(), $log)
+        &&  open(my $handle_log, '>>', $log)
+    ) || return $E->throw($E->DEST_CREATE, $log, $!);
+    _symlink(
+        $DEST_UTIL->path({'name' => $m_ctx->get_name()}, 'sys-log'),
+        $DEST_UTIL->path($m_ctx, 'sys-log-symlink'),
+    );
+    my $log_ctx = $attrib_ref->{util}->util_of_report()->get_ctx($m_ctx);
+    $log_ctx->set_handle($handle_log);
+
+    # Saves as parsed config
+    my $cfg = $DEST_UTIL->path($m_ctx, 'sys-config-as-parsed');
+    (       close($attrib_ref->{handle_cfg})
+        &&  copy($attrib_ref->{handle_cfg}->filename(), $cfg)
+    ) || return $E->throw($E->DEST_CREATE, $cfg, $!);
+    _symlink(
+        $DEST_UTIL->path({'name' => $m_ctx->get_name()}, 'sys-config-as-parsed'),
+        $DEST_UTIL->path($m_ctx, 'sys-config-as-parsed-symlink'),
+    );
+}
+
+# The main function of an instance of this class.
+sub _main {
+    my ($attrib_ref, $option_hash_ref, @args) = @_;
+    my @bad_args;
+    for my $i (0 .. $#args) {
+        if (index($args[$i], "=") < 0) {
+            push(@bad_args, [$i, $args[$i]]);
+        }
+    }
+    if (@bad_args) {
+        return $E->throw($E->MAKE_ARG, \@bad_args);
+    }
+    # Starts the system
+    my $m_ctx = FCM::Context::Make->new({option_of => $option_hash_ref});
+    if ($m_ctx->get_option_of('name')) {
+        $m_ctx->set_name($m_ctx->get_option_of('name'));
+    }
+    my $T = sub {_timer_wrap($attrib_ref, $m_ctx, @_)};
+    my $DEST_UTIL = $attrib_ref->{shared_util_of}{dest};
+    eval {$T->(
+        sub {
+            my %attrib = (
+                %{$attrib_ref},
+                handle_log => File::Temp->new(),
+                handle_cfg => File::Temp->new(),
+            );
+            $attrib_ref->{util}->util_of_report()->add_ctx(
+                $m_ctx, # key
+                {   handle    => $attrib{handle_log},
+                    type      => undef,
+                    verbosity => $attrib_ref->{util}->util_of_report()->HIGH,
+                },
+            );
+            my $version = $attrib_ref->{util}->version();
+            $attrib_ref->{util}->event(
+                FCM::Context::Event->FCM_VERSION, "FCM $version",
+            );
+            for my $step (@INIT_STEPS) {
+                $T->(sub {$ACTION_OF{$step}->(\%attrib, $m_ctx, @args)}, $step);
+            }
+            my $prev_m_ctx = $m_ctx->get_prev_ctx();
+            if (defined($prev_m_ctx)) {
+                for my $step (keys(%{$prev_m_ctx->get_ctx_of()})) {
+                    if (!grep {$_ eq $step} @{$m_ctx->get_steps()}) {
+                        delete($prev_m_ctx->get_ctx_of()->{$step});
+                    }
+                }
+            }
+            for my $step (@{$m_ctx->get_steps()}) {
+                my $ctx = $m_ctx->get_ctx_of($step);
+                if (!defined($ctx)) {
+                    return $E->throw($E->MAKE, $step);
+                }
+                my $id_of_class = $ctx->get_id_of_class();
+                if (!exists($attrib_ref->{subsystem_of}{$id_of_class})) {
+                    return $E->throw($E->MAKE, $step);
+                }
+                my $impl = $attrib_ref->{subsystem_of}{$id_of_class};
+                $ctx->set_status($m_ctx->ST_INIT);
+                if ($ctx->can('set_dest')) {
+                    $ctx->set_dest(
+                        $DEST_UTIL->path($m_ctx, 'target', $ctx->get_id()),
+                    );
+                }
+                eval {$T->(sub {$impl->main($m_ctx, $ctx)}, $step)};
+                if (my $e = $@) {
+                    $ctx->set_status($m_ctx->ST_FAILED);
+                    die($e);
+                }
+                $ctx->set_status($m_ctx->ST_OK);
+                if (    defined($prev_m_ctx)
+                    &&  exists($prev_m_ctx->get_ctx_of()->{$step})
+                ) {
+                    delete($prev_m_ctx->get_ctx_of()->{$step});
+                }
+            }
+        },
+    )};
+    if (my $e = $@) {
+        $m_ctx->set_status($m_ctx->ST_FAILED);
+        $m_ctx->set_error($e);
+        $attrib_ref->{util}->event(FCM::Context::Event->E, $e);
+        _main_finally($attrib_ref, $m_ctx);
+        die("\n");
+    }
+    $m_ctx->set_status($m_ctx->ST_OK);
+    $DEST_UTIL->save(
+        [$attrib_ref->{shared_util_of}{config}->unparse($m_ctx)],
+        $m_ctx,
+        'sys-config-on-success',
+    );
+    _symlink(
+        $DEST_UTIL->path({'name' => $m_ctx->get_name()}, 'sys-config-on-success'),
+        $DEST_UTIL->path($m_ctx, 'sys-config-on-success-symlink'),
+    );
+    _main_finally($attrib_ref, $m_ctx);
+    return $m_ctx;
+}
+
+# Helper to run the "finally" part of "_main".
+sub _main_finally {
+    my ($attrib_ref, $m_ctx) = @_;
+    $m_ctx->set_inherit_ctx_list([]);
+    $m_ctx->set_prev_ctx(undef);
+    $attrib_ref->{shared_util_of}{dest}->dest_done($m_ctx);
+    my $log_ctx = $attrib_ref->{util}->util_of_report()->del_ctx($m_ctx);
+    close($log_ctx->get_handle());
+}
+
+# Wrap "symlink".
+sub _symlink {
+    my ($source, $target) = @_;
+    if (-l $target && readlink($target) eq $source) {
+        return;
+    }
+    if (-e $target || -l $target) {
+        rmtree($target);
+    }
+    symlink($source, $target) || return $E->throw($E->DEST_CREATE, $target, $!);
+}
+
+# Wraps a piece of code with timer events.
+sub _timer_wrap {
+    my ($attrib_ref, $m_ctx, $code_ref, @names) = @_;
+    my @event_args = (
+        FCM::Context::Event->TIMER,
+        join(
+            q{ },
+            $attrib_ref->{name},
+            ($m_ctx->get_name() ? $m_ctx->get_name() : ()),
+            @names,
+        ),
+        time(),
+    );
+    $attrib_ref->{util}->event(@event_args);
+    my $timer = $attrib_ref->{util}->timer();
+    my $return = eval {wantarray() ? [$code_ref->()] : $code_ref->()};
+    my $e = $@;
+    $attrib_ref->{util}->event(@event_args, $timer->(), $e);
+    if ($e) {
+        die($e);
+    }
+    return (wantarray() ? @{$return} : $return);
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make;
+    my $system = FCM::System::Make->new(\%attrib);
+    $system->(\%option);
+
+
+=head1 DESCRIPTION
+
+Invokes the FCM make system.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Creates and returns a new instance. The %attrib may contain the following:
+
+=over 4
+
+=item cfg_base
+
+The base name of the common (site/user) configuration file. (default="make.cfg")
+
+=item name
+
+The name of this sub-system. (default="make")
+
+=item shared_util_of
+
+A HASH to map the names to the classes of the named helper utilities for the
+make system and its sub-systems. (default = %FCM::System::Make::SHARED_UTIL_OF)
+
+=item subsystem_of
+
+A HASH to map the names to the classes of the subsystems. (default =
+%FCM::System::Make::SUBSYSTEM_OF)
+
+=item util
+
+An instance of L<FCM::Util|FCM::Util>.
+
+=back
+
+=item $system->(\%option)
+
+Invokes a make. The %option may contain the following:
+
+=over 4
+
+=item config-file
+
+The path to the configuration file. (default = $PWD/fcm-make.cfg)
+
+=item ignore-lock
+
+This flag can be used to ignore the lock file. The system creates a lock file in
+the destination to prevent another command from running in the same destination.
+If this flag is set, the system will continue even if it encounters a lock file
+in the destination. (default = false)
+
+=item jobs
+
+The number of (child) jobs that can be used to run parallel tasks.
+
+=item new
+
+A flag to tell the system to perform a new make. (default = false, i.e.
+incremental make)
+
+=back
+
+Throws L<FCM::System::Exception|FCM::System::Exception> on error.
+
+=back
+
+=head1 SUBSYSTEMS
+
+A subsystem of the make system should be a CODE-based class that implements a
+particular set of methods. (Some of these methods can be imported from
+L<FCM::System::Make::Share::Subsystem|FCM::System::Make::Share::Subsystem>.) The
+methods that should be implemented are:
+
+=over 4
+
+=item $subsystem_class->new(\%attrib)
+
+Creates a new instance of the subsystem. The make system passes the
+I<shared_util_of>, I<subsystem_of> and I<util> attributes to this method.
+
+=item $subsystem->config_parse($ctx,$entry,$label)
+
+Reads the settings of $entry into the $ctx. The $label is the configuration
+entry label in the context of the subsystem. (This is normally the
+$entry->get_label() but with the context ID prefix removed.). Returns true on
+success.
+
+=item $subsystem->config_parse_inherit_hook($ctx,$i_ctx)
+
+This method is called when the make inherits from an existing make. The $ctx is
+the current subsystem context, and the $i_ctx is the inherited subsystem
+context. This method allows the subsystem to make use of the inherited settings
+in the current context.
+
+=item $subsystem->config_unparse($ctx)
+
+Returns a list of L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry> to
+represent the settings of the $ctx.
+
+=item $subsystem->ctx($id_of_class,$id)
+
+Returns a new context for the subsystem. The $id_of_class is the ID of the
+subsystem class. The $id is the step ID of the context.
+
+=item $subsystem->config_parse_class_prop($entry,$label)
+
+Reads a configuration $entry into the subsystem default property. The $label is
+the label of the $entry, but with the prefix (the subsystem ID plus a dot)
+removed.
+
+=item $subsystem->main($m_ctx,$ctx)
+
+Invokes the subsystem. The $m_ctx is the current context of the make (as a
+blessed reference of L<FCM::Context::Make|FCM::Context::Make>). The $ctx is the
+context of the subsystem.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build.pm	(revision 5095)
@@ -0,0 +1,1834 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build;
+use base qw{FCM::Class::CODE};
+
+use Cwd qw{cwd realpath};
+use FCM::Context::ConfigEntry;
+use FCM::Context::Event;
+use FCM::Context::Make::Build;
+use FCM::Context::Task;
+use FCM::System::Exception;
+use FCM::System::Make::Build::FileType::C;
+use FCM::System::Make::Build::FileType::CXX;
+use FCM::System::Make::Build::FileType::Data;
+use FCM::System::Make::Build::FileType::Fortran;
+use FCM::System::Make::Build::FileType::H;
+use FCM::System::Make::Build::FileType::NS;
+use FCM::System::Make::Build::FileType::Script;
+use FCM::System::Make::Share::Subsystem;
+use File::Basename qw{basename dirname fileparse};
+use File::Find qw{find};
+use File::Path qw{mkpath rmtree};
+use File::Spec::Functions qw{abs2rel catfile rel2abs splitdir splitpath};
+use Storable qw{dclone};
+use Text::ParseWords qw{shellwords};
+
+# Aliases
+our ($EVENT, $UTIL);
+my $E = 'FCM::System::Exception';
+my $STATE = 'FCM::System::Make::Build::State';
+
+# Classes for working with typed source files
+our @FILE_TYPE_UTILS = (
+    'FCM::System::Make::Build::FileType::C',
+    'FCM::System::Make::Build::FileType::CXX',
+    'FCM::System::Make::Build::FileType::Data',
+    'FCM::System::Make::Build::FileType::Fortran',
+    'FCM::System::Make::Build::FileType::H',
+    'FCM::System::Make::Build::FileType::NS',
+    'FCM::System::Make::Build::FileType::Script',
+);
+
+# Default target selection
+our %TARGET_SELECT_BY = (
+    'category' => {},
+    'key'      => {},
+    'task'     => {},
+);
+
+# Configuration parser label to action map
+our %CONFIG_PARSER_OF = (
+    'ns-excl' => _config_parse_ns_filter_func(sub {$_[0]->get_input_ns_excl()}),
+    'ns-incl' => _config_parse_ns_filter_func(sub {$_[0]->get_input_ns_incl()}),
+    'source'  => \&_config_parse_source,
+    'target'  => \&_config_parse_target,
+    'target-rename' => \&_config_parse_target_rename,
+);
+
+# Default properties
+our %PROP_OF = (
+    #                               [default       , ns-ok]
+    'archive-ok-target-category' => [q{include o}  , undef],
+    'checksum-method'            => [q{}           , undef],
+    'ignore-missing-dep-ns'      => [q{}           , undef],
+    'no-step-source'             => [q{}           , undef],
+    'no-inherit-source'          => [q{}           , undef],
+    'no-inherit-target-category' => [q{bin etc lib}, undef],
+);
+
+# Creates the class.
+__PACKAGE__->class(
+    {   config_parser_of  => {isa => '%', default => {%CONFIG_PARSER_OF}},
+        file_type_utils   => {isa => '@', default => [@FILE_TYPE_UTILS]},
+        file_type_util_of => '%',
+        prop_of           => {isa => '%', default => {%PROP_OF}},
+        target_select_by  => {isa => '%', default => {%TARGET_SELECT_BY}},
+        util              => '&',
+    },
+    {   init => \&_init,
+        action_of => {
+            config_parse              => \&_config_parse,
+            config_parse_class_prop   => \&_config_parse_class_prop,
+            config_parse_inherit_hook => \&_config_parse_inherit_hook,
+            config_unparse            => \&_config_unparse,
+            config_unparse_class_prop => \&_config_unparse_class_prop,
+            ctx                       => \&_ctx,
+            ctx_load_hook             => \&_ctx_load_hook,
+            main                      => \&_main,
+        },
+    },
+);
+
+# Initialises the helpers of the class.
+sub _init {
+    my ($attrib_ref) = @_;
+    # Initialises file type utilities, if necessary
+    for my $class (@{$attrib_ref->{file_type_utils}}) {
+        $attrib_ref->{util}->class_load($class);
+        my $file_type_util = $class->new({util => $attrib_ref->{util}});
+        my $id = $file_type_util->id();
+        if (!defined($attrib_ref->{file_type_util_of}{$id})) {
+            $attrib_ref->{file_type_util_of}{$id} = $file_type_util;
+        }
+    }
+    # Initialises properties derived from the file type utilities
+    # TBD: warn if a property is already set and is different from previous?
+    while (
+        my ($id, $file_type_util) = each(%{$attrib_ref->{file_type_util_of}})
+    ) {
+        # File name extension, name pattern and she-bang pattern
+        for my $key (qw{ext pat she}) {
+            my $method = 'file_' . $key;
+            if ($file_type_util->can($method)) {
+                my $value = $file_type_util->$method();
+                if (defined($value)) {
+                    $attrib_ref->{prop_of}{"file-$key.$id"} = [$value];
+                }
+            }
+        }
+        # Dependency types
+        if ($file_type_util->can('source_analyse_deps')) {
+            for my $name ($file_type_util->source_analyse_deps()) {
+                $attrib_ref->{prop_of}{"dep.$name"} = [q{}, 1];
+                $attrib_ref->{prop_of}{"no-dep.$name"} = [q{}, 1];
+            }
+        }
+        # Name-space dependency types
+        if ($file_type_util->can('ns_targets_deps')) {
+            for my $name ($file_type_util->ns_targets_deps()) {
+                $attrib_ref->{prop_of}{"ns-dep.$name"} = [q{}, 1];
+            }
+        }
+        # Target extensions
+        if ($file_type_util->can('target_file_ext_of')) {
+            while (my ($key, $value)
+                = each(%{$file_type_util->target_file_ext_of()})
+            ) {
+                $attrib_ref->{prop_of}{"file-ext.$key"} = [$value, 1];
+            }
+        }
+        # Target file naming options
+        if ($file_type_util->can('target_file_name_option_of')) {
+            while (my ($key, $value)
+                = each(%{$file_type_util->target_file_name_option_of()})
+            ) {
+                $attrib_ref->{prop_of}{"file-name-option.$key"} = [$value, 1];
+            }
+        }
+        # Task properties
+        my %task_of = %{$file_type_util->task_of()};
+        while (my ($name, $task) = each(%task_of)) {
+            if ($task->can('prop_of')) {
+                my %prop_of = %{$task->prop_of()};
+                while (my ($key, $value) = each(%prop_of)) {
+                    $attrib_ref->{prop_of}{$key} = [$value, 1];
+                }
+            }
+        }
+    }
+}
+
+# A hook command for the "inherit/use" declaration.
+sub _config_parse_inherit_hook {
+    my ($attrib_ref, $ctx, $i_ctx) = @_;
+    push(@{$ctx->get_input_ns_excl()}, @{$i_ctx->get_input_ns_excl()});
+    push(@{$ctx->get_input_ns_incl()}, @{$i_ctx->get_input_ns_incl()});
+    while (my ($key, $value) = each(%{$i_ctx->get_target_key_of()})) {
+        $ctx->get_target_key_of()->{$key} = $value;
+    }
+    while (my ($key, $item_ref) = each(%{$i_ctx->get_target_select_by()})) {
+        while (my ($key2, $attr_set) = each(%{$item_ref})) {
+            if (ref($attr_set)) {
+                $ctx->get_target_select_by()->{$key}{$key2} = {%{$attr_set}};
+            }
+            else {
+                # Backward compat, $key2 is an $attr
+                $ctx->get_target_select_by()->{$key}{q{}}{$key2} = 1;
+            }
+        }
+    }
+    _config_parse_inherit_hook_prop($attrib_ref, $ctx, $i_ctx);
+}
+
+# Returns a function to parse a build/preprocess.ns-??cl declaration.
+sub _config_parse_ns_filter_func {
+    my ($getter) = @_;
+    sub {
+        my ($attrib_ref, $ctx, $entry) = @_;
+        if (@{$entry->get_ns_list()}) {
+            return $E->throw($E->CONFIG_NS, $entry);
+        }
+        @{$getter->($ctx)} = map {$_ eq q{/} ? q{} : $_} $entry->get_values();
+    };
+}
+
+# Parses a build/preprocess.source declaration.
+sub _config_parse_source {
+    my ($attrib_ref, $ctx, $entry) = @_;
+    my ($ns) = @{$entry->get_ns_list()};
+    $ns ||= q{};
+    $ctx->get_input_source_of()->{$ns} = [$entry->get_values()];
+}
+
+# Parses a build/preprocess.target declaration.
+sub _config_parse_target {
+    my ($attrib_ref, $ctx, $entry) = @_;
+    my %modifier_of = %{$entry->get_modifier_of()};
+    if (!(%modifier_of)) {
+        %modifier_of = (key => 1);
+    }
+    my @ns_list = map {$_ eq q{/} ? q{} : $_} @{$entry->get_ns_list()};
+    if (exists($modifier_of{'key'}) && grep {$_} @ns_list) {
+        return $E->throw($E->CONFIG_NS, $entry);
+    }
+    if (!@ns_list) {
+        @ns_list = (q{});
+    }
+    while (my $name = each(%modifier_of)) {
+        if (!grep {$_ eq $name} qw{category key task}) {
+            return $E->throw($E->CONFIG_MODIFIER, $entry);
+        }
+        my %attr_set = map {($_ => 1)} $entry->get_values();
+        for my $ns (@ns_list) {
+            $ctx->get_target_select_by()->{$name}{$ns} = \%attr_set;
+        }
+    }
+}
+
+# Parses a build/preprocess.target-rename declaration.
+sub _config_parse_target_rename {
+    my ($attrib_ref, $ctx, $entry) = @_;
+    $ctx->set_target_key_of({
+        map {
+            my ($old, $new) = split(qr{:}msx, $_, 2);
+            if (!$old || !$new) {
+                return $E->throw($E->CONFIG_VALUE, $entry);
+            }
+            ($old => $new);
+        } ($entry->get_values()),
+    });
+}
+
+# Turns a context into a list of configuration entries.
+sub _config_unparse {
+    my ($attrib_ref, $ctx) = @_;
+    my %LABEL_OF
+        = map {($_ => $ctx->get_id() . q{.} . $_)} keys(%CONFIG_PARSER_OF);
+    (   (   @{$ctx->get_input_ns_excl()}
+            ? FCM::Context::ConfigEntry->new({
+                label => $LABEL_OF{'ns-excl'},
+                value => _config_unparse_join(
+                    map {$_ ? $_ : q{/}} @{$ctx->get_input_ns_excl()}
+                ),
+            })
+            : ()
+        ),
+        (   @{$ctx->get_input_ns_incl()}
+            ? FCM::Context::ConfigEntry->new({
+                label => $LABEL_OF{'ns-incl'},
+                value => _config_unparse_join(
+                    map {$_ ? $_ : q{/}} @{$ctx->get_input_ns_incl()}
+                ),
+            })
+            : ()
+        ),
+        (   map {
+                FCM::Context::ConfigEntry->new({
+                    label   => $LABEL_OF{source},
+                    ns_list => [$_],
+                    value   => _config_unparse_join(
+                        sort(@{$ctx->get_input_source_of()->{$_}})
+                    ),
+                })
+            }
+            sort keys(%{$ctx->get_input_source_of()})
+        ),
+        (   keys(%{$ctx->get_target_key_of()})
+            ? FCM::Context::ConfigEntry->new({
+                label => $LABEL_OF{'target-rename'},
+                value => _config_unparse_join(
+                    map {$_ . ':' . $ctx->get_target_key_of()->{$_}}
+                    sort keys(%{$ctx->get_target_key_of()})
+                ),
+            })
+            : ()
+        ),
+        (   map {
+                my $modifier = $_;
+                map {
+                    my $ns = $_;
+                    my @values = sort(keys(
+                        %{$ctx->get_target_select_by()->{$modifier}{$ns}}
+                    ));
+                    FCM::Context::ConfigEntry->new({
+                        label       => $LABEL_OF{'target'},
+                        modifier_of => {$modifier => 1},
+                        ns_list     => [$ns],
+                        value       => _config_unparse_join(@values),
+                    });
+                }
+                sort keys(%{$ctx->get_target_select_by()->{$modifier}});
+            }
+            sort keys(%{$ctx->get_target_select_by()})
+        ),
+        _config_unparse_prop($attrib_ref, $ctx),
+    );
+}
+
+# Returns a new context.
+sub _ctx {
+    my ($attrib_ref, $id_of_class, $id) = @_;
+    FCM::Context::Make::Build->new({
+        id               => $id,
+        id_of_class      => $id_of_class,
+        target_select_by => dclone($attrib_ref->{target_select_by}),
+    });
+}
+
+# Hook when loading a previous ctx.
+sub _ctx_load_hook {
+    my ($attrib_ref, $old_m_ctx, $old_ctx, $old_m_dest, $old_dest) = @_;
+    my $path_mod_func = sub {
+        my ($get_func, $set_func) = @_;
+        my $path = $get_func->();
+        if (!defined($path)) {
+            return;
+        }
+        my $rel_path = abs2rel($path, $old_m_dest);
+        if (index($rel_path, '..') != 0) {
+            $set_func->(catfile($old_m_ctx->get_dest(), $rel_path));
+        }
+    };
+    if (@{$old_ctx->get_dests()}) {
+        $old_ctx->get_dests()->[0] = $old_ctx->get_dest();
+    }
+    while (my ($ns, $source) = each(%{$old_ctx->get_source_of()})) {
+        $path_mod_func->(
+            sub {$source->get_path()},
+            sub {$source->set_path(@_)},
+        );
+    }
+    while (my ($key, $target) = each(%{$old_ctx->get_target_of()})) {
+        $path_mod_func->(
+            sub {$target->get_path()},
+            sub {$target->set_path(@_)},
+        );
+        $path_mod_func->(
+            sub {$target->get_path_of_prev()},
+            sub {$target->set_path_of_prev(@_)},
+        );
+        $path_mod_func->(
+            sub {$target->get_path_of_source()},
+            sub {$target->set_path_of_source(@_)},
+        );
+    }
+}
+
+# The main function of the class.
+sub _main {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    local($UTIL) = $attrib_ref->{util};
+    local($EVENT) = sub {$UTIL->event(@_)};
+    for my $function (
+        \&_sources_locate,
+        \&_sources_type,
+        \&_sources_analyse,
+        \&_targets_update,
+    ) {
+        $function->($attrib_ref, $m_ctx, $ctx);
+    }
+}
+
+# Locates the actual source files, and determines their types.
+sub _sources_locate {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    # From inherited
+    my %NO_INHERIT_FROM
+        = map {($_ => 1)} _props($attrib_ref, 'no-inherit-source', $ctx);
+    if (!$NO_INHERIT_FROM{'*'}) {
+        for my $i_ctx (_i_ctx_list($m_ctx, $ctx)) {
+            while (my ($ns, $source) = each(%{$i_ctx->get_source_of()})) {
+                if (!exists($NO_INHERIT_FROM{$ns})) { # exact name-spaces only
+                    $ctx->get_source_of()->{$ns} = dclone($source);
+                }
+            }
+        }
+    }
+    # From specified input
+    while (my ($ns, $input_sources_ref) = each(%{$ctx->get_input_source_of()})) {
+        for my $input_source (@{$input_sources_ref}) {
+            my $path = realpath(rel2abs($input_source, $m_ctx->get_dest()));
+            _sources_locate_by_find($attrib_ref, $m_ctx, $ctx, $ns, $path);
+        }
+    }
+    # From completed make destinations
+    my %NO_SOURCE_FROM
+        = map {($_, 1)} _props($attrib_ref, 'no-step-source', $ctx);
+    for my $step (@{$m_ctx->get_steps()}) {
+        my $a_ctx = $m_ctx->get_ctx_of($step);
+        if (    !exists($NO_SOURCE_FROM{$step})
+            &&  defined($a_ctx)
+            &&  $a_ctx->get_status() eq $m_ctx->ST_OK
+            &&  $a_ctx->can('get_target_of')
+        ) {
+            my @target_list
+                = grep {$_->can_be_source()} values(%{$a_ctx->get_target_of()});
+            for my $target (@target_list) {
+                if ($target->is_ok() && -e $target->get_path()) {
+                    my $checksum;
+                    if ($target->can('get_checksum')) {
+                        $checksum = $target->get_checksum();
+                    }
+                    my $source = $ctx->CTX_SOURCE->new({
+                        checksum => $checksum,
+                        ns       => $target->get_ns(),
+                        path     => $target->get_path(),
+                    });
+                    $ctx->get_source_of()->{$target->get_ns()} = $source;
+                }
+                elsif (exists($ctx->get_source_of()->{$target->get_ns()})) {
+                    delete($ctx->get_source_of()->{$target->get_ns()});
+                }
+            }
+        }
+    }
+    # Applies filter
+    my %INPUT_NS_EXCL = map {($_, 1)} @{$ctx->get_input_ns_excl()};
+    my %INPUT_NS_INCL = map {($_, 1)} @{$ctx->get_input_ns_incl()};
+    if (keys(%INPUT_NS_EXCL) || keys(%INPUT_NS_INCL)) {
+        while (my ($ns, $source) = each(%{$ctx->get_source_of()})) {
+            my $ns_iter_ref = $UTIL->ns_iter($ns, $UTIL->NS_ITER_UP);
+            NS:
+            while (defined(my $head = $ns_iter_ref->())) {
+                if (exists($INPUT_NS_INCL{$head})) {
+                    last NS;
+                }
+                if (exists($INPUT_NS_EXCL{$head})) {
+                    delete($ctx->get_source_of()->{$ns});
+                    last NS;
+                }
+            }
+        }
+    }
+}
+
+# Locates the actual source files in $path.
+sub _sources_locate_by_find {
+    my ($attrib_ref, $m_ctx, $ctx, $key, $path) = @_;
+    if (!-e $path) {
+        return $E->throw($E->BUILD_SOURCE, $path, $!);
+    }
+    find(
+        sub {
+            my $path_found = $File::Find::name;
+            if (-d $path_found) {
+                return;
+            }
+            my $ns = abs2rel($path_found, $path);
+            if ($ns ne q{.}) {
+                for my $name (split(q{/}, $ns)) {
+                    if (index($name, q{.}) == 0) {
+                        return; # ignore Unix hidden/system files
+                    }
+                }
+            }
+            if ($key) {
+                $ns = $UTIL->ns_cat($key, $ns);
+            }
+            $ctx->get_source_of()->{$ns}
+                = $ctx->CTX_SOURCE->new({ns => $ns, path => $path_found});
+        },
+        $path,
+    );
+}
+
+# Determines source types.
+sub _sources_type {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    my %INPUT_FILE_EXT_TO_TYPE_MAP;
+    my %INPUT_FILE_PAT_TO_TYPE_MAP;
+    my %INPUT_FILE_SHE_TO_TYPE_MAP;
+    for (
+        ['file-ext.', \%INPUT_FILE_EXT_TO_TYPE_MAP, 1],
+        ['file-pat.', \%INPUT_FILE_PAT_TO_TYPE_MAP, 0],
+        ['file-she.', \%INPUT_FILE_SHE_TO_TYPE_MAP, 0],
+    ) {
+        my ($prefix, $map_ref, $value_is_words) = @{$_};
+        for my $id (keys(%{$attrib_ref->{file_type_util_of}})) {
+            my $name = $prefix . $id;
+            my $value = _prop($attrib_ref, $name, $ctx);
+            if (defined($value)) {
+                for my $key (($value_is_words ? shellwords($value) : ($value))) {
+                    $map_ref->{$key} = $id;
+                }
+            }
+        }
+    }
+    my $type_func = sub {
+        my ($path) = @_;
+        # Try file name extension
+        my $extension = $UTIL->file_ext($path);
+        $extension = $extension ? q{.} . $extension : undef;
+        if ($extension && exists($INPUT_FILE_EXT_TO_TYPE_MAP{$extension})) {
+            return $INPUT_FILE_EXT_TO_TYPE_MAP{$extension};
+        }
+        # Try she-bang line
+        if (-T $path) {
+            my $line = $UTIL->file_head($path);
+            if ($line) {
+                while (my ($pattern, $type) = each(%INPUT_FILE_SHE_TO_TYPE_MAP)) {
+                    if (index($line, '#!') == 0) { # OK to hard code this
+                        keys(%INPUT_FILE_SHE_TO_TYPE_MAP); # reset iterator
+                        return $type;
+                    }
+                }
+            }
+        }
+        # Try file name pattern
+        my $base_name = basename($path);
+        while (my ($pattern, $type) = each(%INPUT_FILE_PAT_TO_TYPE_MAP)) {
+            if ($base_name =~ $pattern) {
+                keys(%INPUT_FILE_PAT_TO_TYPE_MAP); # reset iterator
+                return $type;
+            }
+        }
+        return q{};
+    };
+    while (my ($ns, $source) = each(%{$ctx->get_source_of()})) {
+        if (!defined($source->get_type())) {
+            $source->set_type($type_func->($source->get_path()));
+        }
+    }
+}
+
+# Reads source files to gather dependency and other information.
+sub _sources_analyse {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    my $timer = $UTIL->timer();
+    my $checksum_method = _prop($attrib_ref, 'checksum-method', $ctx);
+    my %FILE_TYPE_UTIL_OF = %{$attrib_ref->{file_type_util_of}};
+    # Checksum
+    while (my ($ns, $source) = each(%{$ctx->get_source_of()})) {
+        if (    exists($FILE_TYPE_UTIL_OF{$source->get_type()})
+            &&  !defined($source->get_checksum())
+        ) {
+            $source->set_checksum(
+                $UTIL->file_checksum($source->get_path(), $checksum_method),
+            );
+        }
+    }
+    # Source information
+    my $n_jobs = $m_ctx->get_option_of('jobs');
+    my $runner = $UTIL->task_runner(
+        sub {_source_analyse($attrib_ref, @_)},
+        $n_jobs,
+    );
+    my $elapse_tasks = 0;
+    my $n = eval {
+        $runner->main(
+            _source_analyse_get_func($attrib_ref, $m_ctx, $ctx),
+            _source_analyse_put_func($attrib_ref, $m_ctx, $ctx, \$elapse_tasks),
+        );
+    };
+    my $e = $@;
+    $runner->destroy();
+    if ($e) {
+        die($e);
+    }
+    my $n_total = scalar(keys(%{$ctx->get_source_of()}));
+    $EVENT->(
+        FCM::Context::Event->MAKE_BUILD_SOURCE_SUMMARY,
+        $n_total, $n, $timer->(), $elapse_tasks,
+    );
+}
+
+# Reads a source to gather information.
+sub _source_analyse {
+    my ($attrib_ref, $source) = @_;
+    my $FILE_TYPE_UTIL
+        = $attrib_ref->{file_type_util_of}->{$source->get_type()};
+    if (!$FILE_TYPE_UTIL->can('source_analyse')) {
+        return;
+    }
+    $FILE_TYPE_UTIL->source_analyse($source);
+}
+
+# Generates an iterator for each source file requiring information gathering.
+sub _source_analyse_get_func {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    my $P_SOURCE_GETTER
+        = _prev_hash_item_getter($m_ctx, $ctx, sub {$_[0]->get_source_of()});
+    my %FILE_TYPE_UTIL_OF = %{$attrib_ref->{file_type_util_of}};
+    my $exhausted;
+    sub {
+        if ($exhausted) {
+            return;
+        }
+        SOURCE:
+        while (my ($ns, $source) = each(%{$ctx->get_source_of()})) {
+            my $type = $source->get_type();
+            if (!exists($FILE_TYPE_UTIL_OF{$type})) {
+                next SOURCE;
+            }
+            # Stores the current properties relevant to the source
+            for my $dep_type ($FILE_TYPE_UTIL_OF{$type}->source_analyse_deps()) {
+                for my $n (map {$_ . q{.} . $dep_type} qw{dep no-dep}) {
+                    $source->get_prop_of()->{$n}
+                        = _prop($attrib_ref, $n, $ctx, $ns);
+                }
+            }
+            # Compare with previous source, if possible
+            my $p_source = $P_SOURCE_GETTER->($ns);
+            if (defined($p_source)) {
+                $source->set_up_to_date(
+                    $p_source->get_checksum() eq $source->get_checksum());
+                if (    $source->get_up_to_date()
+                    &&  !$UTIL->hash_cmp(
+                            map {$_->get_prop_of()} ($source, $p_source)
+                        )
+                ) {
+                    $source->set_info_of(dclone($p_source->get_info_of()));
+                    $source->set_deps(   dclone($p_source->get_deps()   ));
+                    next SOURCE;
+                }
+            }
+            return FCM::Context::Task->new({ctx => $source, id  => $ns});
+        }
+        $exhausted = 1;
+        return;
+    };
+}
+
+# Generates a callback when a source read completes.
+sub _source_analyse_put_func {
+    my ($attrib_ref, $m_ctx, $ctx, $elapse_tasks_ref) = @_;
+    my %FILE_TYPE_UTIL_OF = %{$attrib_ref->{file_type_util_of}};
+    sub {
+        my ($task) = @_;
+        if ($task->get_state() eq $task->ST_FAILED) {
+            die($task->get_error());
+        }
+        my $ns = $task->get_id();
+        my $source = $ctx->get_source_of()->{$ns} = $task->get_ctx();
+        for my $type (
+            $FILE_TYPE_UTIL_OF{$source->get_type()}->source_analyse_deps()
+        ) {
+            # Note: "dep" property: use name-space value only
+            my $key = 'dep.' . $type;
+            push(
+                @{$source->get_deps()},
+                (map {[$_, $type]} _props($attrib_ref, $key, $ctx, $ns)),
+            );
+        }
+        ${$elapse_tasks_ref} += $task->get_elapse();
+        $EVENT->(
+            FCM::Context::Event->MAKE_BUILD_SOURCE_ANALYSE,
+            $source, $task->get_elapse(),
+        );
+    }
+}
+
+# Updates the targets.
+sub _targets_update {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    my $timer = $UTIL->timer();
+    # Creates and changes directory to the destination
+    eval {mkpath($ctx->get_dest())};
+    if ($@) {
+        return $E->throw($E->DEST_CREATE, $ctx->get_dest());
+    }
+    my $old_cwd = cwd();
+    chdir($ctx->get_dest()) || die(sprintf("%s: %s\n", $ctx->get_dest(), $!));
+    # Extract any target category directories that are in .tar.gz
+    opendir(my $handle, '.');
+    while (my $name = readdir($handle)) {
+        if ((fileparse($name, '.tar.gz'))[2] eq '.tar.gz') {
+            my %value_of = %{$UTIL->shell_simple([qw{tar -x -z}, '-f', $name])};
+            if ($value_of{'rc'} == 0) {
+                unlink($name);
+            }
+        }
+    }
+    closedir($handle);
+    # Determines the destination search path
+    my $id = $ctx->get_id();
+    @{$ctx->get_dests()} = (
+        $ctx->get_dest(),
+        map {$_->get_ctx_of($id) ? @{$_->get_ctx_of($id)->get_dests()} : ()}
+            @{$m_ctx->get_inherit_ctx_list()}
+        ,
+    );
+    # Performs targets update
+    my $checksum_method = _prop($attrib_ref, 'checksum-method', $ctx);
+    my %stat_of = ();
+    eval {
+        my $n_jobs = $m_ctx->get_option_of('jobs');
+        my $runner = $UTIL->task_runner(
+            sub {_target_update($attrib_ref, $checksum_method, @_)},
+            $n_jobs,
+        );
+        eval {
+            my ($get_ref, $put_ref) = _targets_manager_funcs(
+                 $attrib_ref, $m_ctx, $ctx, \%stat_of,
+            );
+            $runner->main($get_ref, $put_ref);
+        };
+        my $e = $@;
+        $runner->destroy();
+        if ($e) {
+            die($e);
+        }
+    };
+    my $e = $@;
+    # Back to original working directory
+    chdir($old_cwd) || die(sprintf("%s: %s\n", $old_cwd, $!));
+    if ($e) {
+        _finally($attrib_ref, $m_ctx, $ctx);
+        die($e);
+    }
+    # Finally
+    my @targets = values(%{$ctx->get_target_of()});
+    for my $key (sort(keys(%stat_of))) {
+        $stat_of{$key}{n}{$ctx->CTX_TARGET->ST_MODIFIED} ||= 0;
+        $stat_of{$key}{n}{$ctx->CTX_TARGET->ST_UNCHANGED} ||= 0;
+        $stat_of{$key}{n}{$ctx->CTX_TARGET->ST_FAILED} ||= 0;
+        $stat_of{$key}{t} ||= 0.0;
+        $EVENT->(
+            FCM::Context::Event->MAKE_BUILD_TARGET_TASK_SUMMARY,
+            $key,
+            $stat_of{$key}{n}{$ctx->CTX_TARGET->ST_MODIFIED},
+            $stat_of{$key}{n}{$ctx->CTX_TARGET->ST_UNCHANGED},
+            $stat_of{$key}{n}{$ctx->CTX_TARGET->ST_FAILED},
+            $stat_of{$key}{t},
+        );
+    }
+    $EVENT->(
+        FCM::Context::Event->MAKE_BUILD_TARGET_SUMMARY,
+        scalar(grep {$_->is_modified() } @targets),
+        scalar(grep {$_->is_unchanged()} @targets),
+        scalar(grep {$_->is_failed()   } @targets),
+        $timer->(),
+    );
+    my @failed_targets = grep {$_->is_failed()} @targets;
+    if (@failed_targets) {
+        $EVENT->(
+            FCM::Context::Event->MAKE_BUILD_TARGETS_FAIL,
+            \@failed_targets
+        );
+        _finally($attrib_ref, $m_ctx, $ctx);
+        die("\n");
+    }
+    _finally($attrib_ref, $m_ctx, $ctx);
+}
+
+# Updates a target.
+sub _target_update {
+    my ($attrib_ref, $checksum_method, $target) = @_;
+    my $file_type_util = $attrib_ref->{file_type_util_of}{$target->get_type()};
+    eval {$file_type_util->task_of()->{$target->get_task()}->main($target)};
+    if ($@) {
+        if ($target->get_path() && -e $target->get_path()) {
+            unlink($target->get_path());
+        }
+        die($@);
+    }
+    if (! -e $target->get_path()) {
+        return $E->throw($E->BUILD_TARGET, $target);
+    }
+    $target->set_status($target->ST_MODIFIED);
+    my $checksum = $UTIL->file_checksum($target->get_path(), $checksum_method);
+    if ($target->get_checksum() && $checksum eq $target->get_checksum()) {
+        $target->set_status($target->ST_UNCHANGED);
+        if ($target->get_path_of_prev()) {
+            $target->set_path($target->get_path_of_prev());
+        }
+    }
+    $target->set_checksum($checksum);
+    $target->set_prop_of_prev_of({}); # unset
+    $target->set_path_of_prev(undef); # unset
+}
+
+# Returns the get/put functions to send/receive targets to update.
+sub _targets_manager_funcs {
+    my ($attrib_ref, $m_ctx, $ctx, $stat_hash_ref) = @_;
+
+    my @targets;
+    _targets_from_sources($attrib_ref, $m_ctx, $ctx, \@targets);
+    _targets_props_assign($attrib_ref, $m_ctx, $ctx, \@targets);
+
+    my ($stack_ref, $state_hash_ref)
+        = _targets_select($attrib_ref, $m_ctx, $ctx, \@targets);
+
+    my $checksum_method = _prop($attrib_ref, 'checksum-method', $ctx);
+    my $get_action_ref = sub {
+        STATE:
+        while (my $state = pop(@{$stack_ref})) {
+            if (    !$state->is_ready()
+                ||  !_target_deps_are_done($state, $state_hash_ref, $stack_ref)
+            ) {
+                next STATE;
+            }
+            my $target = $state->get_target();
+            if (_target_check_failed_dep($state, $state_hash_ref)) {
+                _target_update_failed(
+                    $stat_hash_ref, $ctx, $target, $state_hash_ref, $stack_ref,
+                );
+            }
+            elsif (_target_check_ood($state, $state_hash_ref, $checksum_method)) {
+                _target_prep($state, $ctx);
+                $state->set_value($STATE->PENDING);
+                # Adds tasks that can be triggered by this task
+                for my $key (sort @{$target->get_triggers()}) {
+                    if (    exists($state_hash_ref->{$key})
+                        &&  !$state_hash_ref->{$key}->is_done()
+                        &&  !grep {$_->get_id() eq $key} @{$stack_ref}
+                    ) {
+                        my $trigger_target
+                            = $state_hash_ref->{$key}->get_target();
+                        $trigger_target->set_status($trigger_target->ST_OOD);
+                        push(@{$stack_ref}, $state_hash_ref->{$key});
+                    }
+                }
+                return FCM::Context::Task->new(
+                    {ctx => $target, id => $state->get_id()},
+                );
+            }
+            else {
+                _target_update_ok(
+                    $stat_hash_ref, $ctx, $target, $state_hash_ref, $stack_ref,
+                );
+            }
+        }
+        return;
+    };
+    my $put_action_ref = sub {
+        my $task = shift();
+        my $target = $task->get_ctx();
+        if ($task->get_state() eq $task->ST_FAILED) {
+            $EVENT->(FCM::Context::Event->E, $task->get_error());
+            _target_update_failed(
+                $stat_hash_ref, $ctx, $target, $state_hash_ref, $stack_ref,
+                $task->get_elapse(),
+            );
+        }
+        else {
+            my $target = $task->get_ctx();
+            _target_update_ok(
+                $stat_hash_ref, $ctx, $target, $state_hash_ref, $stack_ref,
+                $task->get_elapse(),
+            );
+        }
+    };
+    ($get_action_ref, $put_action_ref);
+}
+
+# Determines and returns the targets from the sources.
+sub _targets_from_sources {
+    my ($attrib_ref, $m_ctx, $ctx, $targets_ref) = @_;
+    my %FILE_TYPE_UTIL_OF = %{$attrib_ref->{file_type_util_of}};
+    my %FILE_EXT_OF;
+    my %FILE_NAME_OPTION_OF;
+    for my $FILE_TYPE_UTIL (values(%FILE_TYPE_UTIL_OF)) {
+        while (my $key = each(%{$FILE_TYPE_UTIL->target_file_ext_of()})) {
+            $FILE_EXT_OF{$key} ||= _prop($attrib_ref, 'file-ext.' . $key, $ctx);
+        }
+        while (my $key = each(%{$FILE_TYPE_UTIL->target_file_name_option_of()})) {
+            $FILE_NAME_OPTION_OF{$key}
+                ||= _prop($attrib_ref, 'file-name-option.' . $key, $ctx);
+        }
+    }
+    # Determine the targets for each source
+    my %reverse_deps_of = ();
+    SOURCE:
+    while (my ($ns, $source) = each(%{$ctx->get_source_of()})) {
+        my $type = $source->get_type();
+        $type ||= q{};
+        if (!exists($FILE_TYPE_UTIL_OF{$type})) {
+            next SOURCE;
+        }
+        my $FILE_TYPE_UTIL = $FILE_TYPE_UTIL_OF{$type};
+        if (!$FILE_TYPE_UTIL->can('source_to_targets')) {
+            next SOURCE;
+        }
+        for my $target (
+            $FILE_TYPE_UTIL->source_to_targets(
+                $source, \%FILE_EXT_OF, \%FILE_NAME_OPTION_OF)
+        ) {
+            my $key = $target->get_key();
+            if (exists($ctx->get_target_key_of()->{$key})) {
+                $key = $ctx->get_target_key_of()->{$key};
+                $target->set_key($key);
+            }
+            push(@{$targets_ref}, $target);
+            $target->set_ns($ns);
+            $target->set_path(
+                catfile($ctx->get_dest(), $target->get_category(), $key),
+            );
+            $target->set_path_of_source($source->get_path());
+            $target->set_type($type);
+            if (!$source->get_up_to_date()) {
+                $target->set_status($target->ST_OOD);
+            }
+            if (exists($target->get_info_of()->{'parents'})) {
+                for my $parent (@{$target->get_info_of()->{'parents'}}) {
+                    if (!exists($reverse_deps_of{$parent})) {
+                        $reverse_deps_of{$parent} = [];
+                    }
+                    push(
+                        @{$reverse_deps_of{$parent}},
+                        [$key, $target->get_category()],
+                    );
+                }
+            }
+        }
+    }
+    # Add reverse dependencies
+    # E.g. Fortran module has link time dependency on its submodules
+    for my $target (@{$targets_ref}) {
+        if (exists($reverse_deps_of{$target->get_key()})) {
+            push(@{$target->get_deps()}, @{$reverse_deps_of{$target->get_key()}});
+        }
+    }
+    # Determines name-space dependencies
+    my %deps_in_ns_in_cat_of; # $cat => {$ns => [$targets ...]}
+    FILE_TYPE_UTIL:
+    while (my ($type, $FILE_TYPE_UTIL) = each(%FILE_TYPE_UTIL_OF)) {
+        if (!$FILE_TYPE_UTIL->can('ns_targets')) {
+            next FILE_TYPE_UTIL;
+        }
+        for my $cat ($FILE_TYPE_UTIL->ns_targets_deps()) {
+            $deps_in_ns_in_cat_of{$cat} = {};
+        }
+        for my $target (
+            $FILE_TYPE_UTIL->ns_targets(
+                $targets_ref, \%FILE_EXT_OF, \%FILE_NAME_OPTION_OF)
+        ) {
+            my $key = $target->get_key();
+            if (exists($ctx->get_target_key_of()->{$key})) {
+                $key = $ctx->get_target_key_of()->{$key};
+                $target->set_key($key);
+            }
+            push(@{$targets_ref}, $target);
+            $target->set_type($type);
+            $target->set_path(
+                catfile($ctx->get_dest(), $target->get_category(), $key),
+            );
+        }
+    }
+    for my $target (
+        sort {
+            $a->get_ns() cmp $b->get_ns() || $a->get_key() cmp $b->get_key();
+        } @{$targets_ref}
+    ) {
+        $EVENT->(
+            FCM::Context::Event->MAKE_BUILD_TARGET_FROM_NS,
+            ($target->get_ns() ? $target->get_ns() : '/'),
+            $target->get_task(),
+            $target->get_category(),
+            $target->get_key(),
+        );
+    }
+    # Target categories and name-spaces.
+    for my $target (@{$targets_ref}) {
+        my $cat = $target->get_category();
+        if ($cat && exists($deps_in_ns_in_cat_of{$cat})) {
+            my $ns_iter = $UTIL->ns_iter($target->get_ns(), $UTIL->NS_ITER_UP);
+            # $ns_iter->(); # discard
+            while (defined(my $ns = $ns_iter->())) {
+                $deps_in_ns_in_cat_of{$cat}{$ns} ||= [];
+                push(@{$deps_in_ns_in_cat_of{$cat}{$ns}}, $target->get_key());
+            }
+        }
+    }
+
+    my %CTX_PROP_OF = %{$ctx->get_prop_of()};
+    for my $target (@{$targets_ref}) {
+        my $key = $target->get_key();
+        # Adds categorised name-space dependencies.
+        if (exists($target->get_info_of()->{'deps'})) {
+            CATEGORY:
+            while (my ($cat, $deps_in_ns_ref) = each(%deps_in_ns_in_cat_of)) {
+                if (!exists($target->get_info_of()->{'deps'}{$cat})) {
+                    next CATEGORY;
+                }
+                my $cfg_key = 'ns-dep.' . $cat;
+                my @ns_list = map {$_ eq q{/} ? q{} : $_}
+                    _props($attrib_ref, $cfg_key, $ctx, $target->get_ns());
+                for my $ns (@ns_list) {
+                    if (exists($deps_in_ns_ref->{$ns})) {
+                        push(
+                            @{$target->get_deps()},
+                            (   map  {[$_, $cat]}
+                                grep {$_ ne $key}
+                                @{$deps_in_ns_ref->{$ns}}
+                            ),
+                        );
+                    }
+                    else {
+                        # This will be reported later as missing dependency
+                        push(@{$target->get_deps()}, [$ns, $cat, 'ns-dep']);
+                    }
+                }
+            }
+        }
+        # Remove target dependencies, if necessary
+        my @deps;
+        DEP:
+        for my $dep (@{$target->get_deps()}) {
+            my ($dep_key, $dep_type) = @{$dep};
+            my $cfg_key = 'no-dep.' . $dep_type;
+            if (    !exists($CTX_PROP_OF{$cfg_key})
+                ||  !exists($CTX_PROP_OF{$cfg_key}->get_ctx_of()->{$key})
+            ) {
+                push(@deps, $dep);
+                next DEP;
+            }
+            my @no_dep_keys = shellwords(
+                $CTX_PROP_OF{$cfg_key}->get_ctx_of()->{$key}->get_value());
+            if (!grep {$_ eq $dep_key} @no_dep_keys) {
+                push(@deps, $dep);
+                next DEP;
+            }
+        }
+        $target->set_deps(\@deps);
+        # Add target dependencies, if necessary
+        for my $dep_type (keys(%{$target->get_dep_policy_of()})) {
+            my $cfg_key = 'dep.' . $dep_type;
+            if (    exists($CTX_PROP_OF{$cfg_key})
+                &&  exists($CTX_PROP_OF{$cfg_key}->get_ctx_of()->{$key})
+            ) {
+                my @dep_keys = shellwords(
+                    $CTX_PROP_OF{$cfg_key}->get_ctx_of()->{$key}->get_value());
+                for my $dep_key (@dep_keys) {
+                    push(@{$target->get_deps()}, [$dep_key, $dep_type]);
+                }
+            }
+        }
+    }
+}
+
+# Stores the properties relevant to the target.
+# Assigns previous checksum and properties, where appropriate.
+sub _targets_props_assign {
+    my ($attrib_ref, $m_ctx, $ctx, $targets_ref) = @_;
+    my $P_TARGET_GETTER
+        = _prev_hash_item_getter($m_ctx, $ctx, sub {$_[0]->get_target_of()});
+    my %NO_INHERIT_CATEGORY_IN
+        = map {$_ => 1} _props($attrib_ref, 'no-inherit-target-category', $ctx);
+    my %CTX_PROP_OF = %{$ctx->get_prop_of()};
+    for my $target (@{$targets_ref}) {
+        my $key = $target->get_key();
+        # Properties
+        my $FILE_TYPE_UTIL
+            = $attrib_ref->{file_type_util_of}->{$target->get_type()};
+        my $task = $FILE_TYPE_UTIL->task_of()->{$target->get_task()};
+        if ($task->can('prop_of')) {
+            my %prop_of = %{$task->prop_of($target)};
+            while (my $name = each(%prop_of)) {
+                if (    exists($CTX_PROP_OF{$name})
+                    &&  exists($CTX_PROP_OF{$name}->get_ctx_of()->{$key})
+                ) {
+                    $target->get_prop_of()->{$name}
+                        = $CTX_PROP_OF{$name}->get_ctx_of()->{$key}->get_value();
+                }
+                else {
+                    $target->get_prop_of()->{$name}
+                        = _prop($attrib_ref, $name, $ctx, $target->get_ns());
+                }
+            }
+        }
+        if ($FILE_TYPE_UTIL->can('target_deps_filter')) {
+            $FILE_TYPE_UTIL->target_deps_filter($target);
+        }
+        # Path, checksum and previous properties
+        my $p_target = $P_TARGET_GETTER->($key);
+        if (defined($p_target)) {
+            $target->set_checksum($p_target->get_checksum());
+            if ($p_target->is_ok()) {
+                $target->set_path_of_prev($p_target->get_path());
+                $target->set_prop_of_prev_of($p_target->get_prop_of());
+            }
+            else {
+                $target->set_path_of_prev($p_target->get_path_of_prev());
+                $target->set_prop_of_prev_of($p_target->get_prop_of_prev_of());
+                $target->set_status($target->ST_OOD);
+            }
+            if (exists($NO_INHERIT_CATEGORY_IN{$target->get_category()})) {
+                $target->set_path_of_prev($target->get_path());
+            }
+        }
+    }
+}
+
+# Selects targets to update.
+sub _targets_select {
+    my ($attrib_ref, $m_ctx, $ctx, $targets_ref) = @_;
+    my $time = time();
+    my $timer = $UTIL->timer();
+    my %select_by = %{$ctx->get_target_select_by()};
+    my %target_of;
+    my %targets_of;
+    my %target_set;
+    my %has_ns_in; # available sets of name-spaces
+    for my $target (@{$targets_ref}) {
+        ATTR_NAME:
+        for (
+            #$attr_name, $attr_func
+            ['key'     , sub {$_[0]->get_key()}],
+            ['category', sub {$_[0]->get_category()}],
+            ['task'    , sub {$_[0]->get_task()}],
+        ) {
+            my ($attr_name, $attr_func) = @{$_};
+            for my $ns (sort keys(%{$select_by{$attr_name}})) {
+                my %attr_set = %{$select_by{$attr_name}->{$ns}};
+                if (    exists($attr_set{$attr_func->($target)})
+                    &&  (!$ns || $UTIL->ns_in_set($target->get_ns(), {$ns => 1}))
+                ) {
+                    $target_set{$target->get_key()} = 1;
+                    last ATTR_NAME;
+                }
+            }
+        }
+        if (exists($target_of{$target->get_key()})) {
+            if (!exists($targets_of{$target->get_key()})) {
+                $targets_of{$target->get_key()}
+                    = [delete($target_of{$target->get_key()})];
+            }
+            push(@{$targets_of{$target->get_key()}}, $target);
+        }
+        else {
+            $target_of{$target->get_key()} = $target;
+        }
+        # Name-spaces
+        my $ns_iter = $UTIL->ns_iter($target->get_ns(), $UTIL->NS_ITER_UP);
+        NS:
+        while (defined(my $ns = $ns_iter->())) {
+            if (exists($has_ns_in{$ns})) {
+                last NS;
+            }
+            $has_ns_in{$ns} = 1;
+        }
+    }
+    my @target_keys = sort keys(%target_set);
+
+    # Wraps each relevant target with a state object.
+    # Walks the target dependency tree to build a state dependency tree.
+    # Checks for missing dependencies.
+    # Checks for duplicated target.
+    my @items = map {[[$_, undef]]} @target_keys;
+    my %state_of;
+    my %dup_in;
+    my %cyc_in;
+    my %missing_deps_in;
+    ITEM:
+    while (my $item = pop(@items)) {
+        my ($unit, @up_units) = @{$item};
+        my ($key, $type) = @{$unit};
+        my @up_keys = map {$_->[0]} @up_units;
+        if (   exists($cyc_in{$key})
+            || exists($dup_in{$key})
+            || exists($missing_deps_in{$key})
+        ) {
+            next ITEM;
+        }
+        if (exists($state_of{$key})) {
+            # Already visited this ITEM
+            # Detect cyclic dependency
+            if (    !$state_of{$key}->get_cyclic_ok()
+                &&  grep {$_->[0] eq $key} @up_units
+            ) {
+                my @_up_units = (@up_units, $unit);
+                my $_up_unit_last = pop(@_up_units);
+                DEP_UP_KEY:
+                while (my $_up_unit = pop(@_up_units)) {
+                    my ($_up_key, $_up_type) = @{$_up_unit};
+                    my @dep_up_deps = @{$state_of{$_up_key}->get_deps()};
+                    # If parent of $_up_unit_last does not depend on
+                    # $_up_unit_last, chain is broken, and we are OK.
+                    my ($_up_key_last, $_up_type_last) = @{$_up_unit_last};
+                    if (!grep {     $_->[0]->get_key() eq $_up_key_last
+                                ||  $_->[1] eq $_up_type_last
+                        } @dep_up_deps
+                    ) {
+                        last DEP_UP_KEY;
+                    }
+                    if ($type && $key eq $_up_key && $type eq $_up_type) {
+                        $cyc_in{$key} = {'keys' => [@up_keys, $key]};
+                        next ITEM;
+                    }
+                    $_up_unit_last = $_up_unit;
+                }
+            }
+            $state_of{$key}->set_cyclic_ok(1);
+            # Float current target up dependency chain
+            my $is_directly_related = 1;
+            UP_KEY:
+            for my $up_key (reverse(@up_keys)) {
+                if ($state_of{$up_key}->add_visitor(
+                        $state_of{$key}->get_target(),
+                        $type,
+                        $is_directly_related,
+                )) {
+                    last UP_KEY;
+                }
+                $is_directly_related = 0;
+            }
+            # Add floatable dependencies up the dependency chain
+            for my $visitor (values(%{$state_of{$key}->get_floatables()})) {
+                UP_KEY:
+                for my $up_key (reverse(@up_keys)) {
+                    if ($state_of{$up_key}->add_visitor(@{$visitor})) {
+                        last UP_KEY;
+                    }
+                }
+            }
+            next ITEM;
+        }
+
+        # First visit to this ITEM
+        # Checks for duplicated target
+        if (exists($targets_of{$key})) {
+            $dup_in{$key} = {
+                'keys' => [@up_keys, $key],
+                'values' => [map {$_->get_ns()} @{$targets_of{$key}}],
+            };
+            next ITEM;
+        }
+        # Wraps all required targets with a STATE object
+        $state_of{$key} = $STATE->new(
+            {id => $key, target => $target_of{$key}},
+        );
+        my $target = $target_of{$key};
+        DEP:
+        for (
+            grep {$_->[0] ne $key}
+            sort {$a->[0] cmp $b->[0]}
+            @{$target->get_deps()}
+        ) {
+            my ($dep_key, $dep_type, $dep_remark) = @{$_};
+            # Duplicated targets
+            if (exists($targets_of{$dep_key})) {
+                $dup_in{$dep_key} = {
+                    'keys' => [@up_keys, $key, $dep_key],
+                    'values' => [map {$_->get_ns()} @{$targets_of{$dep_key}}],
+                };
+                next DEP;
+            }
+            # Missing dependency
+            if (!exists($target_of{$dep_key})) {
+                if (!exists($missing_deps_in{$key})) {
+                    $missing_deps_in{$key} = {
+                        'keys'   => [@up_keys, $key, $dep_key],
+                        'values' => [],
+                    };
+                }
+                push(
+                    @{$missing_deps_in{$key}{'values'}},
+                    [$dep_key, $dep_type, $dep_remark],
+                );
+                next DEP;
+            }
+            # OK
+            push(@items, [[$dep_key, $dep_type], @up_units, [$key, $type]]);
+            # add_visitor, is_directly_related=1
+            $state_of{$key}->add_visitor($target_of{$dep_key}, $dep_type, 1)
+        }
+        # Float current target up dependency chain
+        my $is_directly_related = 1;
+        UP_KEY:
+        for my $up_key (reverse(@up_keys)) {
+            if ($state_of{$up_key}->add_visitor(
+                    $target, $type, $is_directly_related,
+            )) {
+                last UP_KEY;
+            }
+            $is_directly_related = 0;
+        }
+        # Adds triggers
+        for my $trigger_key (@{$target->get_triggers()}) {
+            if (!exists($state_of{$trigger_key})) {
+                unshift(@items, [[$trigger_key, undef]]);
+            }
+        }
+    }
+    # Visitors no longer used
+    for my $state (values(%state_of)) {
+        $state->free_visitors();
+    }
+    # Assigns targets to build context
+    %{$ctx->get_target_of()}
+        = map {($_->get_id() => $_->get_target())} values(%state_of);
+
+    # Report cyclic dependencies
+    # Report duplicated targets
+    # Report missing dependencies
+    # Report bad keys in target select
+    if (keys(%cyc_in)) {
+        return $E->throw($E->BUILD_TARGET_CYC, \%cyc_in);
+    }
+    if (keys(%dup_in)) {
+        return $E->throw($E->BUILD_TARGET_DUP, \%dup_in);
+    }
+    my @ignore_missing_dep_ns_list = map {$_ eq q{/} ? q{} : $_} (
+        _props($attrib_ref, 'ignore-missing-dep-ns', $ctx)
+    );
+    KEY:
+    for my $key (sort(keys(%missing_deps_in))) {
+        my $target = $target_of{$key};
+        for my $ns (@ignore_missing_dep_ns_list) {
+            if ($UTIL->ns_common($ns, $target->get_ns()) eq $ns) { # target in ns
+                my $hash_ref = delete($missing_deps_in{$key});
+                my @deps = @{$hash_ref->{"values"}};
+                for my $dep (@deps) {
+                    $EVENT->(
+                        FCM::Context::Event->MAKE_BUILD_TARGET_MISSING_DEP,
+                        $key, @{$dep},
+                    );
+                }
+                next KEY;
+            }
+        }
+    }
+    if (keys(%missing_deps_in)) {
+        return $E->throw($E->BUILD_TARGET_DEP, \%missing_deps_in);
+    }
+    if (exists($select_by{key}{q{}})) {
+        my @bad_keys = grep {!exists($state_of{$_})} keys(%{$select_by{key}{q{}}});
+        if (@bad_keys) {
+            return $E->throw($E->BUILD_TARGET_BAD, \@bad_keys);
+        }
+    }
+    # Walk the tree and report it
+    my @report_items = map {[$_]} sort @target_keys;
+    my %reported;
+    ITEM:
+    while (my $item = pop(@report_items)) {
+        my ($key, @stack) = @{$item};
+        my @deps = sort {$a->[0]->get_key() cmp $b->[0]->get_key()}
+            @{$state_of{$key}->get_deps()};
+        my @more_items = reverse(map {[$_->[0]->get_key(), @stack, $key]} @deps);
+        my $n_more_items;
+        if (exists($reported{$key})) {
+            $n_more_items = scalar(@more_items);
+        }
+        else {
+            push(@report_items, @more_items);
+        }
+        $attrib_ref->{util}->event(
+            FCM::Context::Event->MAKE_BUILD_TARGET_STACK,
+            $key, scalar(@stack), $n_more_items,
+        );
+        $reported{$key} = 1;
+    }
+    $EVENT->(
+        FCM::Context::Event->MAKE_BUILD_TARGET_SELECT,
+        {map {$_ => $target_of{$_}} @target_keys},
+    );
+    # TODO: error if nothing to build?
+
+    # Checks whether properties with name-spaces are valid.
+    my @invalid_prop_ns_list;
+    while (my ($name, $prop) = each(%{$ctx->get_prop_of()})) {
+        while (my ($ns, $prop_ctx) = each(%{$prop->get_ctx_of()})) {
+            if (    !$prop_ctx->get_inherited()
+                &&  !exists($target_of{$ns})
+                &&  !exists($has_ns_in{$ns})
+            ) {
+                push(
+                    @invalid_prop_ns_list,
+                    [$ctx->get_id(), $name, $ns, $prop_ctx->get_value()],
+                );
+            }
+        }
+    }
+    if (@invalid_prop_ns_list) {
+        return $E->throw($E->MAKE_PROP_NS, \@invalid_prop_ns_list);
+    }
+
+    $EVENT->(FCM::Context::Event->MAKE_BUILD_TARGET_SELECT_TIMER, $timer->());
+
+    # Returns list of keys of top targets, and the states
+    ([map {$state_of{$_}} reverse(@target_keys)], \%state_of);
+}
+
+# Returns true if $target dependencies are done.
+sub _target_deps_are_done {
+    my ($state, $state_hash_ref, $stack_ref) = @_;
+    my @deps = map {[$_->[0]->get_key(), $_->[1]]} @{$state->get_deps()};
+    for my $k (sort grep {$state_hash_ref->{$_}->is_ready()} map {$_->[0]} @deps) {
+        if (!grep {$_->get_id() eq $k} @{$stack_ref}) {
+            push(@{$stack_ref}, $state_hash_ref->{$k});
+        }
+    }
+    my %not_done
+        = map  {@{$_}}
+          grep {!$_->[1]->is_done()}
+          map  {[$_->[0], $state_hash_ref->{$_->[0]}]}
+          @deps;
+    if (keys(%not_done)) {
+        $state->set_value($STATE->PENDING);
+        while (my ($k, $s) = each(%not_done)) {
+            $state->get_pending_for()->{$k} = $s;
+            $s->get_needed_by()->{$state->get_id()} = $state;
+        }
+        return 0;
+    }
+    return 1;
+}
+
+# Returns true if $target has failed dependencies.
+sub _target_check_failed_dep {
+    my ($state, $state_hash_ref) = @_;
+    my $target = $state->get_target();
+    for my $dep (@{$state->get_deps()}) {
+        my ($target_of_dep, $type_of_dep) = @{$dep};
+        if ($target_of_dep->is_failed()) {
+            return 1;
+        }
+        if (    exists($target_of_dep->get_status_of()->{$type_of_dep})
+            &&  $target_of_dep->get_status_of()->{$type_of_dep}
+                    eq $target->ST_FAILED
+        ) {
+            return 1;
+        }
+    }
+    return 0;
+}
+
+# Returns true if $target is out of date.
+sub _target_check_ood {
+    my ($state, $state_hash_ref, $checksum_method) = @_;
+    my $target = $state->get_target();
+    # Dependencies
+    my $rc;
+    for my $dep (@{$state->get_deps()}) {
+        my ($target_of_dep, $type_of_dep) = @{$dep};
+        if (    $target_of_dep->is_modified()
+            ||  exists($target_of_dep->get_status_of()->{$type_of_dep})
+                &&  $target_of_dep->get_status_of()->{$type_of_dep}
+                    eq $target->ST_MODIFIED
+        ) {
+            if (exists($target->get_status_of()->{$type_of_dep})) {
+                $target->get_status_of()->{$type_of_dep} = $target->ST_MODIFIED;
+                if (    $target->get_path_of_prev()
+                    &&  $target->get_path() ne $target->get_path_of_prev()
+                ) {
+                    # Inherited build, cannot just pass on a status
+                    $rc = 1;
+                }
+            }
+            else {
+                $rc = 1;
+            }
+        }
+    }
+    if ($rc || $target->get_status() eq $target->ST_OOD) {
+        return 1;
+    }
+    # Dest and properties
+    my $path_of_prev = $target->get_path_of_prev();
+    my $checksum = $target->get_checksum();
+    my $prop_hash_ref = $target->get_prop_of();
+    my $prop_of_prev_hash_ref = $target->get_prop_of_prev_of();
+    (       !$path_of_prev
+        ||  !-e $path_of_prev
+        ||  $UTIL->file_checksum($path_of_prev, $checksum_method) ne $checksum
+        ||  $UTIL->hash_cmp($prop_hash_ref, $prop_of_prev_hash_ref)
+    );
+}
+
+# Callback to prepare the target for the task.
+sub _target_prep {
+    my ($state, $ctx) = @_;
+    my $target = $state->get_target();
+    # Creates the container directory, where necessary
+    my %paths_of_dirs_set;
+    for my $t (
+        $target,
+        map {$ctx->get_target_of($_)} @{$target->get_triggers()},
+    ) {
+        $paths_of_dirs_set{dirname($t->get_path())} = 1;
+    }
+    for my $path_of_dir (keys(%paths_of_dirs_set)) {
+        if (!-d $path_of_dir) {
+            eval {mkpath($path_of_dir)};
+            if ($@) {
+                return $E->throw($E->DEST_CREATE, $path_of_dir);
+            }
+        }
+    }
+    # Put in required info
+    if ($target->get_info_of('paths')) {
+        @{$target->get_info_of('paths')} = @{$ctx->get_dests()};
+    }
+    if ($target->get_info_of('deps')) {
+        my $info_deps_ref = $target->get_info_of('deps');
+        my %set_of = map {$_ => {}} keys(%{$info_deps_ref});
+        for my $dep (@{$state->get_deps()}) {
+            my ($target_of_dep, $type) = @{$dep};
+            my $key = $target_of_dep->get_key();
+            if (exists($set_of{$type}) && !$set_of{$type}{$key}) {
+                if ($target_of_dep->get_ns() eq $target->get_ns()) {
+                    # E.g. main *.o of *.exe
+                    unshift(@{$info_deps_ref->{$type}}, $key);
+                }
+                else {
+                    push(@{$info_deps_ref->{$type}}, $key);
+                }
+                $set_of{$type}{$key} = 1;
+            }
+        }
+    }
+}
+
+# Sets state and stack when a $target has failed to update or cannot be updated
+# due to failed dependencies.
+sub _target_update_failed {
+    my ($stat_hash_ref,
+        $ctx,
+        $target,
+        $state_hash_ref,
+        $stack_ref,
+        $elapsed_time, # only defined if target update action is done
+    ) = @_;
+    my $key = $target->get_key();
+    my $state = $state_hash_ref->{$key};
+    $state->set_value($STATE->DONE);
+    # If this target is needed by other targets...
+    while (my ($k, $s) = each(%{$state->get_needed_by()})) {
+        my $pending_for_ref = $s->get_pending_for();
+        delete($pending_for_ref->{$key});
+        if (!keys(%{$pending_for_ref})) {
+            $s->set_value($STATE->DONE);
+            # Remove from stack
+            @{$stack_ref} = grep {$_->get_id() ne $k} @{$stack_ref};
+            $s->get_target()->set_status($target->ST_FAILED);
+            push(@{$s->get_target()->get_failed_by()}, $key);
+        }
+    }
+    if (defined($elapsed_time)) { # Done target update
+        my $target0 = $ctx->get_target_of()->{$target->get_key()};
+        $target0->set_info_of({}); # unset
+        $target0->set_checksum(undef);
+        $target0->set_path(undef);
+        $target0->set_prop_of_prev_of({}); # unset
+        $target0->set_path_of_prev(undef); # unset
+        $target0->set_status($target->ST_FAILED);
+        push(@{$target0->get_failed_by()}, $target->get_key());
+        ++$stat_hash_ref->{$target->get_task()}{n}{$target->ST_FAILED};
+        $stat_hash_ref->{$target->get_task()}{t} += $elapsed_time;
+    }
+    else { # No target update required
+        $target->set_path(undef);
+        $target->set_prop_of_prev_of({}); # unset
+        $target->set_path_of_prev(undef); # unset
+        $target->set_status($target->ST_FAILED);
+        for my $dep (@{$state->get_deps()}) {
+            my ($dep_target, $dep_type) = @{$dep};
+            my $dep_key = $dep_target->get_key();
+            if (    $dep_target->is_failed()
+                &&  !grep {$_ eq $dep_key} @{$target->get_failed_by()}
+            ) {
+                push(@{$target->get_failed_by()}, $dep_key);
+            }
+        }
+        ++$stat_hash_ref->{$target->get_task()}{n}{$target->ST_FAILED};
+    }
+    $EVENT->(
+        FCM::Context::Event->MAKE_BUILD_TARGET_FAIL, $target, $elapsed_time,
+    );
+}
+
+# Sets state and stack when a $target is up to date or updated successfully.
+sub _target_update_ok {
+    my ($stat_hash_ref,
+        $ctx,
+        $target,
+        $state_hash_ref,
+        $stack_ref,
+        $elapsed_time, # only defined if target update action is done
+    ) = @_;
+    my $key = $target->get_key();
+    my $state = $state_hash_ref->{$key};
+    $state->set_value($STATE->DONE);
+    # If this target is needed by other targets...
+    my @released_pending_states;
+    while (my ($k, $s) = each(%{$state->get_needed_by()})) {
+        my $pending_for_ref = $s->get_pending_for();
+        delete($pending_for_ref->{$key});
+        if ($s->is_pending() && !keys(%{$pending_for_ref})) {
+            $s->set_value($STATE->READY);
+            if (!grep {$_->get_id() eq $k} @{$stack_ref}) {
+                push(@released_pending_states, $s);
+            }
+        }
+    }
+    push(
+        @{$stack_ref},
+        sort {$a->get_id() cmp $b->get_id()} @released_pending_states,
+    );
+    if (defined($elapsed_time)) { # Done target update
+        my $target0 = $ctx->get_target_of()->{$target->get_key()};
+        $target0->set_info_of({}); # unset
+        $target0->set_checksum($target->get_checksum());
+        $target0->set_path($target->get_path());
+        $target0->set_prop_of_prev_of({}); # unset
+        $target0->set_path_of_prev(undef); # unset
+        $target0->set_status($target->get_status());
+        ++$stat_hash_ref->{$target->get_task()}{n}{$target->get_status()};
+        $stat_hash_ref->{$target->get_task()}{t} += $elapsed_time;
+    }
+    else { # No target update required
+        if ($target->get_path_of_prev()) {
+            $target->set_path($target->get_path_of_prev());
+        }
+        $target->set_prop_of_prev_of({}); # unset
+        $target->set_path_of_prev(undef); # unset
+        $target->set_status($target->ST_UNCHANGED);
+        ++$stat_hash_ref->{$target->get_task()}{n}{$target->ST_UNCHANGED};
+    }
+    $EVENT->(
+        FCM::Context::Event->MAKE_BUILD_TARGET_DONE, $target, $elapsed_time,
+    );
+}
+
+# Returns a list containing the inherited contexts with the same ID as $ctx.
+sub _i_ctx_list {
+    my ($m_ctx, $ctx) = @_;
+    grep
+        {defined()}
+    map
+        {$_->get_ctx_of($ctx->get_id())}
+    @{$m_ctx->get_inherit_ctx_list()};
+}
+
+# Returns a function that returns the previous source/target of a specified key.
+sub _prev_hash_item_getter {
+    my ($m_ctx, $ctx, $getter_ref) = @_;
+    my $p_m_ctx = $m_ctx->get_prev_ctx();
+    my %p_item_of;
+    my $ctx_id = $ctx->get_id();
+    if (defined($p_m_ctx) && defined($p_m_ctx->get_ctx_of($ctx_id))) {
+        %p_item_of = %{$getter_ref->($p_m_ctx->get_ctx_of($ctx_id))};
+    }
+    else {
+        for my $i_ctx (_i_ctx_list($m_ctx, $ctx)) {
+            %p_item_of = (%p_item_of, %{$getter_ref->($i_ctx)});
+        }
+    }
+    sub {exists($p_item_of{$_[0]}) ? $p_item_of{$_[0]} : undef};
+}
+
+# Perform final actions.
+# Archive intermediate target directories if necessary.
+sub _finally {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    if (!$m_ctx->get_option_of('archive')) {
+        return;
+    }
+    my %can_archive = map {($_ => 1)} _props(
+        $attrib_ref, 'archive-ok-target-category', $ctx);
+    opendir(my $handle, $ctx->get_dest());
+    while (my $name = readdir($handle)) {
+        if ($can_archive{$name}) {
+            my @command = (
+                qw{tar -c -z}, '-C', $ctx->get_dest(),
+                '-f', catfile($ctx->get_dest(), $name . '.tar.gz'),
+                $name,
+            );
+            my %value_of = %{$UTIL->shell_simple(\@command)};
+            if ($value_of{'rc'} == 0) {
+                rmtree(catfile($ctx->get_dest(), $name));
+            }
+        }
+    }
+    closedir($handle);
+}
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::State;
+use base qw{FCM::Class::HASH};
+
+use constant {
+    DONE       => 'DONE',       # state value
+    READY      => 'READY',      # state value
+    PENDING    => 'PENDING',    # state value
+};
+
+__PACKAGE__->class({
+    cyclic_ok   => '$',
+    deps        => '@',
+    floatables  => '%',
+    id          => '$',
+    needed_by   => '%',
+    pending_for => '%',
+    target      => 'FCM::Context::Make::Build::Target',
+    value       => {isa => '$', default => READY},
+    visited_by  => '%',
+});
+
+sub add_visitor {
+    my ($self, $dep_target, $dep_type, $is_directly_related) = @_;
+    my $dep_key = $dep_target->get_key();
+    my $dep_str = join(':', $dep_key, $dep_type);
+    # Dependency has already visited me, return cached return value
+    if (exists($self->get_visited_by()->{$dep_str})) {
+        return $self->get_visited_by()->{$dep_str};
+    }
+    # Adopt dep_target as my dependency if there is a policy to do so
+    my $target = $self->get_target();
+    my $policy = $target->get_dep_policy_of($dep_type);
+    if (    $policy
+        &&  ($policy ne $target->POLICY_FILTER_IMMEDIATE || $is_directly_related)
+        &&  (!grep {$_->[0]->get_key() eq $dep_key} @{$self->get_deps()})
+        &&  (!grep {$_ eq $dep_key} @{$target->get_triggers()})
+    ) {
+        push(@{$self->get_deps()}, [$dep_target, $dep_type]);
+    }
+    # If target is captured by me, return true.
+    # Otherwise, return false, and the target is a floatable.
+    $self->get_visited_by()->{$dep_str}
+        = ($policy && $policy eq $target->POLICY_CAPTURE);
+    if (    !$self->get_visited_by()->{$dep_str}
+        &&  !exists($self->get_floatables()->{$dep_str})
+    ) {
+        $self->get_floatables()->{$dep_str} = [$dep_target, $dep_type];
+    }
+    return $self->get_visited_by()->{$dep_str};
+}
+
+sub free_visitors {
+    my ($self) = @_;
+    %{$self->get_floatables()} = ();
+    %{$self->get_visited_by()} = ();
+}
+
+sub is_done {
+    $_[0]->{value} eq DONE;
+}
+
+sub is_pending {
+    $_[0]->{value} eq PENDING;
+}
+
+sub is_ready {
+    $_[0]->{value} eq READY;
+}
+#-------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build;
+
+=head1 DESCRIPTION
+
+Implements the build sub-system. An instance of this class is expected to be
+initialised and called by L<FCM::System::Make|FCM::System::Make>.
+
+=head1 METHODS
+
+See L<FCM::System::Make|FCM::System::Make> for detail.
+
+=head1 ATTRIBUTES
+
+The $class->new(\%attrib) method of this class supports the following
+attributes:
+
+=over 4
+
+=item config_parser_of
+
+A HASH to map the labels in a configuration file to their parsers. (default =
+%FCM::System::Make::Build::CONFIG_PARSER_OF)
+
+=item target_select_by
+
+A HASH to map the default target selector. The keys should be "category", "key",
+"ns", or "task". (default = %FCM::System::Make::Build::TARGET_SELECT_by)
+
+=item file_type_utils
+
+An ARRAY of file type utility classes to be loaded into the file_type_util_of
+HASH. (default = @FCM::System::Make::Build::FILE_TYPE_UTILS)
+
+=item file_type_util_of
+
+A HASH to map the file type names to the utilities to manipulate the given file
+types. An values in this HASH overrides the classes in I<file_type_utils>.
+(default = determined by I<file_type_utils>)
+
+=item prop_of
+
+A HASH to map the names of the properties to their settings. Each setting
+is a 2-element ARRAY reference, where element [0] is the default setting
+and element [1] is a flag to indicate whether the property accepts a name-space
+or not. (default = %FCM::System::Make::Build::PROP_OF + values loaded from the
+file type utilities)
+
+=item util
+
+See L<FCM::System::Make|FCM::System::Make> for detail.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType.pm	(revision 5095)
@@ -0,0 +1,226 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::FileType;
+use base qw{FCM::Class::CODE};
+
+use Text::ParseWords qw{shellwords};
+
+# Creates the class.
+__PACKAGE__->class(
+    {   id                         => '$',
+        file_ext                   => '$',
+        file_pat                   => '$',
+        file_she                   => '$',
+        source_analyse_always      => '$',
+        source_analyse_dep_of      => '%',
+        source_analyse_more        => '&',
+        source_analyse_more_init   => '&',
+        source_to_targets          => '&',
+        target_deps_filter         => '&',
+        target_file_ext_of         => '%',
+        target_file_name_option_of => '%',
+        task_class_of              => '%',
+        task_of                    => '%',
+        util                       => '&',
+    },
+    {   init => \&_init,
+        action_of => {
+            (map {my $key = $_; ($key => sub {$_[0]->{$key}})}
+                qw{
+                    id
+                    file_ext
+                    file_pat
+                    file_she
+                    source_analyse_always
+                    target_file_ext_of
+                    target_file_name_option_of
+                    task_of
+                }
+            ),
+            source_analyse      => \&_source_analyse,
+            source_analyse_deps => sub {keys(%{$_[0]->{source_analyse_dep_of}})},
+            source_to_targets   => sub {$_[0]->{source_to_targets}->(@_)},
+            target_deps_filter  => sub {$_[0]->{target_deps_filter}->(@_)},
+        },
+    },
+);
+
+# Initialises some attributes.
+sub _init {
+    my ($attrib_ref) = @_;
+    while (my ($key, $class) = each(%{$attrib_ref->{task_class_of}})) {
+        $attrib_ref->{util}->class_load($class);
+        $attrib_ref->{task_of}{$key}
+            = $class->new({util => $attrib_ref->{util}});
+    }
+}
+
+# Reads information according to the $source.
+sub _source_analyse {
+    my ($attrib_ref, $source) = @_;
+    my %no_dep_of;
+    my %dep_type_of
+        = map {($_ => 1)} keys(%{$attrib_ref->{source_analyse_dep_of}});
+    while (my $type = each(%dep_type_of)) {
+        my $key = 'no-dep.' . $type;
+        if ($source->get_prop_of($key)) {
+            for my $v (shellwords($source->get_prop_of($key))) {
+                if ($v eq '*') {
+                    delete($dep_type_of{$type});
+                }
+                else {
+                    $no_dep_of{$type}{$v} = 1;
+                }
+            }
+        }
+    }
+    if (!keys(%dep_type_of) && !$attrib_ref->{source_analyse_always}) {
+        return;
+    }
+    my $path = $source->get_path();
+    my $handle = $attrib_ref->{util}->file_load_handle($path);
+
+    my @dep_types = keys(%dep_type_of)
+        ? keys(%dep_type_of) : (_source_analyse_deps($attrib_ref));
+    my (%dep_of, %info_of, %state);
+    $attrib_ref->{source_analyse_more_init}->(\%info_of, \%state);
+    LINE:
+    while (my $line = readline($handle)) {
+        chomp($line);
+        TYPE:
+        for my $type (@dep_types) {
+            my ($item, $can_analyse_more)
+                = $attrib_ref->{source_analyse_dep_of}{$type}->($line);
+            if ($item) {
+                $dep_of{$type}{$item} = 1;
+                if ($can_analyse_more) {
+                    last TYPE;
+                }
+                else {
+                    next LINE;
+                }
+            }
+        }
+        $attrib_ref->{source_analyse_more}->($line, \%info_of, \%state);
+    }
+
+    close($handle);
+    $source->set_info_of(\%info_of);
+    while (my ($type, $hash_ref) = each(%dep_of)) {
+        while (my $item = each(%{$hash_ref})) {
+            if (!exists($no_dep_of{$type}{$item})) {
+                push(@{$source->get_deps()}, [$item, $type]);
+            }
+        }
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::FileType
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::FileType;
+    my $file_type_util = FCM::System::Make::Build::FileType->new(\%attrib);
+    $file_type_util->source_analyse($handle);
+
+=head1 DESCRIPTION
+
+An abstract class to implement the shared methods for gathering information to
+build different types of source files.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Creates and returns a new instance.
+
+=item $instance->id()
+
+Returns the recommended ID of this file type.
+
+=item $instance->file_ext()
+=item $instance->file_pat()
+=item $instance->file_she()
+
+Returns the recommended file name extension, file name pattern and file she-bang
+line pattern of this file type.
+
+=item $instance->source_analyse($source)
+
+Analysis $source for dependencies and other information. Add or modify items in
+@{$source->get_deps()} and %{$source->get_info_of()}.
+
+=item $instance->source_analyse_deps()
+
+Returns a list containing the possible dependency types.
+
+=item $instance->source_analyse_always()
+
+Returns true if $instance->source_analyse($handle,\@dep_types) can read
+information other than dependencies.
+
+=item $instance->source_to_targets($source,\%prop_of)
+
+Using the information in $source, creates and returns the contexts of a list of
+suitable build targets. Where appropriate, the %prop_of should contain a mapping
+of the names of the properties used by this method and their values.
+
+=item $instance->target_deps_filter($target)
+
+This may modify @{$target->get_deps()} in place based on values in
+%{$target->get_prop_of()}. This method is normally implemented by sub-classes.
+
+=item $instance->target_file_ext_of()
+
+Returns a HASH reference containing a map between the named types of file
+extensions used by the $instance->source_to_targets($source,\%prop_of) method
+and their default values.
+
+=item $instance->target_file_name_option_of()
+
+Returns a HASH reference containing a map between the named types of files
+used by the $instance->source_to_targets($source,\%prop_of) method
+and their default settings for other file naming options.
+
+=item $instance->task_of()
+
+Returns a HASH reference containing a map between the named tasks for this file
+type and their implementation objects. Each task should have a
+$task->main($target) method to update a target and optionally a $task->prop_of()
+method to return a HASH reference containing a map between the named properties
+used by the task and their default values.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/C.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/C.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/C.pm	(revision 5095)
@@ -0,0 +1,156 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::FileType::C;
+use base qw{FCM::System::Make::Build::FileType};
+
+use FCM::Context::Make::Build; # for FCM::Context::Make::Build::Target
+use FCM::System::Make::Build::Task::Compile::C;
+use FCM::System::Make::Build::Task::Install;
+use FCM::System::Make::Build::Task::Link::C;
+use File::Basename qw{basename};
+
+# RE: file (base) name
+my $RE_FILE = qr{[\w\-+.]+}imsx;
+
+# RE: main program
+my $RE_MAIN = qr{\A\s*(?:int|void)?\s*main\b\s*\(?}msx;
+
+my %SOURCE_ANALYSE_DEP_OF = (
+    include => sub { $_[0] =~ qr{\A\#\s*include\s+"($RE_FILE)"}msx },
+    o => sub { lc($_[0]) =~ qr{\A\s*/\*\s*depends\s*on\s*:\s*($RE_FILE)}imsx },
+);
+my $TARGET = 'FCM::Context::Make::Build::Target';
+my %TASK_CLASS_OF = (
+    'compile' => 'FCM::System::Make::Build::Task::Compile::C',
+    'install' => 'FCM::System::Make::Build::Task::Install',
+    'link'    => 'FCM::System::Make::Build::Task::Link::C',
+);
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        FCM::System::Make::Build::FileType->new({
+            id                       => 'c',
+            file_ext                 => '.c .i .m .mi',
+            source_analyse_always    => 1,
+            source_analyse_dep_of    => {%SOURCE_ANALYSE_DEP_OF},
+            source_analyse_more      => \&_source_analyse_more,
+            source_analyse_more_init => \&_source_analyse_more_init,
+            source_to_targets        => \&_source_to_targets,
+            target_file_ext_of       => {bin => '.exe', o => '.o'},
+            task_class_of            => {%TASK_CLASS_OF},
+            %{$attrib_ref},
+        }),
+        $class,
+    );
+}
+
+sub _source_analyse_more {
+    my ($line, $info_hash_ref) = @_;
+    if (!$info_hash_ref->{main} && $line =~ $RE_MAIN) {
+        return $info_hash_ref->{main} = 1;
+    }
+    return;
+}
+
+sub _source_analyse_more_init {
+    my ($info_hash_ref) = @_;
+    $info_hash_ref->{main} = 0;
+}
+
+# Returns a list of targets for a given build source.
+sub _source_to_targets {
+    my ($attrib_ref, $source, $prop_hash_ref) = @_;
+    my $key = basename($source->get_path());
+    my ($ext, $root) = $attrib_ref->{util}->file_ext($key);
+    my %dot = %{$prop_hash_ref};
+    my @deps = @{$source->get_deps()};
+    my $key_o = lc($root) . $dot{o}; # lc for legacy
+    my @targets = (
+        $TARGET->new(
+            {   category  => $TARGET->CT_INCLUDE,
+                deps      => [@deps],
+                dep_policy_of => {'include' => $TARGET->POLICY_CAPTURE},
+                key       => $key,
+                status_of => {'include' => $TARGET->ST_UNKNOWN},
+                task      => 'install',
+            }
+        ),
+        $TARGET->new(
+            {   category      => $TARGET->CT_O,
+                deps          => [@deps],
+                dep_policy_of => {'include' => $TARGET->POLICY_CAPTURE},
+                info_of       => {paths => []},
+                key           => $key_o,
+                task          => 'compile',
+            }
+        ),
+    );
+
+    if ($source->get_info_of()->{'main'}) {
+        my @link_deps = grep {$_->[1] eq 'o'} @deps;
+        push(
+            @targets,
+            $TARGET->new(
+                {   category   => $TARGET->CT_BIN,
+                    deps       => [[$key_o, 'o'], @link_deps],
+                    dep_policy_of => {
+                        map {($_ => $TARGET->POLICY_CAPTURE)} qw{o o.special},
+                    },
+                    info_of    => {
+                        paths => [], deps => {o => [], 'o.special' => []},
+                    },
+                    key        => $root . $dot{bin},
+                    task       => 'link',
+                }
+            )
+        );
+    }
+    return @targets;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::FileType::C
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::FileType::C;
+    my $helper = FCM::System::Make::Build::FileType::C->new();
+    $helper->source_analyse($handle);
+
+=head1 DESCRIPTION
+
+A wrapper of
+L<FCM::System::Make::Build::FileType|FCM::System::Make::Build::FileType> with
+configurations to work with C source files.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/CPP.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/CPP.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/CPP.pm	(revision 5095)
@@ -0,0 +1,92 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::FileType::CPP;
+use base qw{FCM::System::Make::Build::FileType};
+
+use FCM::Context::Make::Build; # for FCM::Context::Make::Build::Target
+use FCM::System::Make::Build::Task::Preprocess::C;
+
+# Dependency types and CODE to extract them
+my %SOURCE_ANALYSE_DEP_OF
+    = (include => sub { $_[0] =~ qr{\A\#\s*include\s+"([\w\-+.]+)"}msx });
+
+# Handler of tasks
+my %TASK_CLASS_OF
+    = (process => 'FCM::System::Make::Build::Task::Preprocess::C');
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        FCM::System::Make::Build::FileType->new({
+            id                    => 'cpp',
+            file_ext              => '.c .m .cc .cp .cxx .cpp .CPP .c++ .C .mm .M',
+            source_analyse_dep_of => {%SOURCE_ANALYSE_DEP_OF},
+            source_to_targets     => \&_source_to_targets,
+            target_file_ext_of    => {},
+            task_class_of         => {%TASK_CLASS_OF},
+            %{$attrib_ref},
+        }),
+        $class,
+    );
+}
+
+# Returns a list of targets for a given build source.
+sub _source_to_targets {
+    my ($attrib_ref, $source) = @_;
+    my $TARGET = 'FCM::Context::Make::Build::Target';
+    $TARGET->new(
+        {   category      => $TARGET->CT_SRC,
+            deps          => [@{$source->get_deps()}],
+            dep_policy_of => {'include' => $TARGET->POLICY_CAPTURE},
+            info_of       => {paths => []},
+            key           => $source->get_ns(),
+            task          => 'process',
+        }
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::FileType::CPP
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::FileType::CPP;
+    my $helper = FCM::System::Make::Build::FileType::CPP->new();
+    $helper->source_analyse($handle);
+
+=head1 DESCRIPTION
+
+A wrapper of
+L<FCM::System::Make::Build::FileType|FCM::System::Make::Build::FileType> with
+configurations to work with C source files for preprocessing.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/CXX.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/CXX.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/CXX.pm	(revision 5095)
@@ -0,0 +1,72 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::FileType::CXX;
+use base qw{FCM::System::Make::Build::FileType::C};
+
+use FCM::System::Make::Build::Task::Compile::CXX;
+use FCM::System::Make::Build::Task::Install;
+use FCM::System::Make::Build::Task::Link::CXX;
+
+my %TASK_CLASS_OF = (
+    'compile' => 'FCM::System::Make::Build::Task::Compile::CXX',
+    'install' => 'FCM::System::Make::Build::Task::Install',
+    'link'    => 'FCM::System::Make::Build::Task::Link::CXX',
+);
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        FCM::System::Make::Build::FileType::C->new({
+            id            => 'cxx',
+            file_ext      => '.cc .cp .cxx .cpp .CPP .c++ .C .mm .M .mii',
+            task_class_of => {%TASK_CLASS_OF},
+            %{$attrib_ref},
+        }),
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::FileType::CXX
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::FileType::CXX;
+    my $helper = FCM::System::Make::Build::FileType::CXX->new();
+    $helper->source_analyse($handle);
+
+=head1 DESCRIPTION
+
+A wrapper of
+L<FCM::System::Make::Build::FileType::C|FCM::System::Make::Build::FileType::C>
+with configurations to work with C++ source files.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/Data.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/Data.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/Data.pm	(revision 5095)
@@ -0,0 +1,82 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::FileType::Data;
+use base qw{FCM::System::Make::Build::FileType};
+
+use FCM::Context::Make::Build;    # for FCM::Context::Make::Build::Target
+use FCM::System::Make::Build::Task::Install;
+
+# Handler of tasks
+my %TASK_CLASS_OF = (install => 'FCM::System::Make::Build::Task::Install');
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        FCM::System::Make::Build::FileType->new({
+            id                    => q{},
+            source_analyse_dep_of => {},
+            source_to_targets     => \&_source_to_targets,
+            target_file_ext_of    => {},
+            task_class_of         => {%TASK_CLASS_OF},
+            %{$attrib_ref},
+        }),
+        $class,
+    );
+}
+
+# Returns a list of targets for a given build source.
+sub _source_to_targets {
+    my ($attrib_ref, $source) = @_;
+    FCM::Context::Make::Build::Target->new(
+        {   category => FCM::Context::Make::Build::Target->CT_ETC,
+            key      => $source->get_ns(),
+            task     => 'install',
+        }
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::FileType::Data
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::FileType::Data;
+    my $helper = FCM::System::Make::Build::FileType::Data->new();
+    $helper->source_analyse($handle);
+
+=head1 DESCRIPTION
+
+A class based on
+L<FCM::System::Make::Build::FileType|FCM::System::Make::Build::FileType>
+with configurations to install data files to the etc/ sub-directory of a build.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/FPP.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/FPP.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/FPP.pm	(revision 5095)
@@ -0,0 +1,67 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::FileType::FPP;
+use base qw{FCM::System::Make::Build::FileType::CPP};
+
+use FCM::System::Make::Build::Task::Preprocess::Fortran;
+
+my %TASK_CLASS_OF
+    = (process => 'FCM::System::Make::Build::Task::Preprocess::Fortran');
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        FCM::System::Make::Build::FileType::CPP->new({
+            id            => 'fpp',
+            file_ext      => '.F90 .F95 .F .FTN .FOR',
+            task_class_of => {%TASK_CLASS_OF},
+            %{$attrib_ref},
+        }),
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::FileType::FPP
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::FileType::FPP;
+    my $helper = FCM::System::Make::Build::FileType::FPP->new();
+    $helper->source_analyse($handle);
+
+=head1 DESCRIPTION
+
+A wrapper of
+L<FCM::System::Make::Build::FileType::CPP|FCM::System::Make::Build::FileType::CPP>
+with configurations to work with Fortran source files for preprocessing.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/Fortran.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/Fortran.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/Fortran.pm	(revision 5095)
@@ -0,0 +1,420 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::FileType::Fortran;
+use base qw{FCM::System::Make::Build::FileType};
+
+use FCM::Context::Make::Build;    # for FCM::Context::Make::Build::Target
+use FCM::System::Make::Build::Task::Compile::Fortran;
+use FCM::System::Make::Build::Task::ExtractInterface;
+use FCM::System::Make::Build::Task::Install;
+use FCM::System::Make::Build::Task::Link::Fortran;
+use File::Basename qw{basename};
+use Text::Balanced qw{extract_bracketed extract_delimited};
+
+# Recommended file extensions of this utility
+our $FILE_EXT = '.F .F90 .F95 .FOR .FTN .f .f90 .f95 .for .ftn .inc';
+
+# List of Fortran intrinsic modules
+our @INTRINSIC_MODULES = qw{
+    ieee_arithmetic
+    ieee_exceptions
+    ieee_features
+    iso_c_binding
+    iso_fortran_env
+    omp_lib
+    omp_lib_kinds
+};
+
+# Prefix for dependency name that is only applicable under OMP
+our $OMP_PREFIX = '!$';
+
+# Regular expressions
+my $RE_FILE = qr{[\w\-+.]+}imsx;
+my $RE_NAME = qr{[A-Za-z]\w*}imsx;
+my $RE_SPEC = qr{
+    character|class|complex|double\s*complex|double\s*precision|integer|
+    logical|procedure|real|type
+}imsx;
+my $RE_UNIT_BASE = qr{
+    block\s*data|
+    module(?!\s*(?:function|subroutine|procedure)\s+)|
+    program|
+}imsx;
+my $RE_UNIT_CALL = qr{subroutine|function}imsx;
+my %RE           = (
+    DEP_O     => qr{\A\s*!\s*depends\s*on\s*:\s*($RE_FILE)}imsx,
+    DEP_USE   => qr{\A\s*use\s+($RE_NAME)}imsx,
+    DEP_SUBM  => qr{\A\s*submodule\s+\(($RE_NAME)\)}imsx,
+    INCLUDE   => qr{\#?\s*include\s*}imsx,
+    OMP_SENT  => qr{\A(\s*!\$\s+)?(.*)\z}imsx,
+    UNIT_ATTR => qr{\A\s*(?:(?:(?:impure\s+)?elemental|recursive|pure)\s+)+(.*)\z}imsx,
+    UNIT_BASE => qr{\A\s*($RE_UNIT_BASE)\s+($RE_NAME)\b}imsx,
+    UNIT_SUBM => qr{\A\s*(submodule)\s*\(($RE_NAME)\)\s*($RE_NAME)\b}imsx,
+    UNIT_CALL => qr{\A\s*($RE_UNIT_CALL)\s+($RE_NAME)\b}imsx,
+    UNIT_END  => qr{\A\s*(end)(?:\s+($RE_NAME)(?:\s+($RE_NAME))?)?\b}imsx,
+    UNIT_SPEC => qr{\A\s*$RE_SPEC\b(.*)\z}imsx,
+);
+
+# Dependency types and extractors
+my %SOURCE_ANALYSE_DEP_OF = (
+    'f.module'  => \&_source_analyse_dep_module,
+    'include'   => \&_source_analyse_dep_include,
+    'o'         => sub { lc($_[0]) =~ $RE{DEP_O} }, # lc required for legacy
+    'o.special' => sub {},
+);
+# Alias
+my $TARGET = 'FCM::Context::Make::Build::Target';
+# Classes for tasks used by targets of this file type
+my %TASK_CLASS_OF = (
+    'compile'   => 'FCM::System::Make::Build::Task::Compile::Fortran',
+    'compile+'  => 'FCM::System::Make::Build::Task::Compile::Fortran::Extra',
+    'ext-iface' => 'FCM::System::Make::Build::Task::ExtractInterface',
+    'install'   => 'FCM::System::Make::Build::Task::Install',
+    'link'      => 'FCM::System::Make::Build::Task::Link::Fortran',
+);
+# Property suffices of output file extensions
+my %TARGET_EXT_OF = (
+    'bin'           => '.exe',
+    'f90-interface' => '.interface',
+    'f90-mod'       => '.mod',
+    'o'             => '.o',
+);
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        FCM::System::Make::Build::FileType->new({
+            id                         => 'fortran',
+            file_ext                   => $FILE_EXT,
+            source_analyse_always      => 1,
+            source_analyse_dep_of      => {%SOURCE_ANALYSE_DEP_OF},
+            source_analyse_more        => \&_source_analyse_more,
+            source_analyse_more_init   => \&_source_analyse_more_init,
+            source_to_targets          => \&_source_to_targets,
+            target_deps_filter         => \&_target_deps_filter,
+            target_file_ext_of         => {%TARGET_EXT_OF},
+            target_file_name_option_of => {'f90-mod' => q{}},
+            task_class_of              => {%TASK_CLASS_OF},
+            %{$attrib_ref},
+        }),
+        $class,
+    );
+}
+
+sub _source_analyse_more {
+    my ($line, $info_hash_ref, $state) = @_;
+
+    # End Interface
+    if ($state->{in_interface}) {
+        if ($line =~ qr{\A\s*end\s*interface\b}imsx) {
+            $state->{in_interface} = 0;
+        }
+        return 1;
+    }
+
+    # End Program Unit
+    if (@{$state->{stack}} && $line =~ qr{\A\s*end\b}imsx) {
+        my ($end, $type, $symbol) = lc($line) =~ $RE{UNIT_END};
+        if (!$end) {
+            return 1;
+        }
+        my ($top_type, $top_symbol) = @{$state->{stack}->[-1]};
+        if (!$type
+            || $top_type eq $type && (!$symbol || $top_symbol eq $symbol))
+        {
+            pop(@{$state->{stack}});
+            if ($state->{in_contains} && !@{$state->{stack}}) {
+                $state->{in_contains} = 0;
+            }
+        }
+        return 1;
+    }
+
+    # Interface/Contains
+    if ($line =~ qr{\A\s*contains\b}imsx) {
+        $state->{'in_contains'} = 1;
+        return 1;
+    }
+    if ($line =~ qr{\A\s*(?:abstract\s+)?interface\b}imsx) {
+        $state->{'in_interface'} = 1;
+        return 1;
+    }
+
+    # Program Unit
+    my ($type, $symbol, @extras) = _process_prog_unit($line);
+    if ($type) {
+        if (!@{$state->{stack}}) {
+            if ($type eq 'program') {
+                $info_hash_ref->{main} = 1;
+            }
+            $info_hash_ref->{symbols} ||= [];
+            push(@{$info_hash_ref->{symbols}}, [$type, $symbol, @extras]);
+        }
+        push(@{$state->{stack}}, [$type, $symbol]);
+        return 1;
+    }
+    return;
+}
+
+sub _source_analyse_more_init {
+    my ($info_ref, $state) = @_;
+    %{$info_ref} = (main => 0, symbols => []);
+    %{$state} = (in_contains => undef, in_interface => undef, stack => []);
+}
+
+# Reads information: extract an include dependency.
+sub _source_analyse_dep_include {
+    my ($line) = @_;
+    my ($omp_sentinel, $extracted);
+    ($omp_sentinel, $line) = $line =~ $RE{OMP_SENT};
+    ($extracted) = extract_delimited($line, q{'"}, $RE{INCLUDE});
+    if (!$extracted) {
+        return;
+    }
+    $extracted = substr($extracted, 1, length($extracted) - 2);
+    if ($omp_sentinel) {
+        $extracted = $OMP_PREFIX . $extracted;
+    }
+    $extracted;
+}
+
+# Reads information: extract a module dependency.
+sub _source_analyse_dep_module {
+    my ($line) = @_;
+    my ($omp_sentinel, $extracted, $can_analyse_more);
+    ($omp_sentinel, $line) = $line =~ $RE{OMP_SENT};
+    ($extracted) = lc($line) =~ $RE{DEP_USE};
+    if (!$extracted) {
+        ($extracted) = lc($line) =~ $RE{DEP_SUBM};
+        $can_analyse_more = 1;
+    }
+    if (!$extracted || grep {$_ eq $extracted} @INTRINSIC_MODULES) {
+        return;
+    }
+    if ($omp_sentinel) {
+        $extracted = $OMP_PREFIX . $extracted;
+    }
+    ($extracted, $can_analyse_more);
+}
+
+# Parse a statement for program unit header. Returns a list containing the type,
+# the symbol and the signature tokens of the program unit.
+sub _process_prog_unit {
+    my ($string) = @_;
+    my ($type, $symbol, $symbol_parent) = (q{}, q{}, q{});
+    ($type, $symbol) = lc($string) =~ $RE{UNIT_BASE};
+    if ($type) {
+        $type =~ s{\s*}{}gmsx;
+        return ($type, $symbol);
+    }
+    ($type, $symbol_parent, $symbol) = lc($string) =~ $RE{UNIT_SUBM};
+    if ($type) {
+        return ($type, $symbol, $symbol_parent);
+    }
+    $string =~ s/$RE{UNIT_ATTR}/$1/;
+    my ($match) = $string =~ $RE{UNIT_SPEC};
+    if ($match) {
+        $string = $match;
+        if ($string =~ qr{\A \s* \(}msx) {
+            extract_bracketed($string);
+        }
+        elsif ($string =~ qr{\A \s* \*}msx) {
+            $string =~ s{\A \s* \* \d+ \s*}{}msx;
+        }
+    }
+    ($type, $symbol) = lc($string) =~ $RE{UNIT_CALL};
+    if (!$type) {
+        return;
+    }
+    return (lc($type), lc($symbol));
+}
+
+# Returns a list of targets for a given build source.
+sub _source_to_targets {
+    my ($attrib_ref, $source, $ext_hash_ref, $option_hash_ref) = @_;
+    my $key = basename($source->get_path());
+    my $TARGET_OF = sub {
+        my ($symbol, $type) = @_;
+        if (exists($option_hash_ref->{$type})) {
+            my $is_upper = index($option_hash_ref->{$type}, 'case=upper') >= 0;
+            $symbol = $is_upper ? uc($symbol) : lc($symbol);
+        }
+        $symbol . $ext_hash_ref->{$type};
+    };
+    my @deps = map {
+        my ($k, $type) = @{$_};
+        my $ext = $attrib_ref->{util}->file_ext($k);
+          $type eq 'f.module'   ? [$TARGET_OF->($k, 'f90-mod'), 'include', 1]
+        : $type eq 'o' && !$ext ? [$TARGET_OF->($k, 'o'), $type]
+        :                         [$k, $type]
+    } @{$source->get_deps()};
+    # All source files can be used as include files
+    my @targets = (
+        $TARGET->new(
+            {   category  => $TARGET->CT_INCLUDE,
+                deps      => [@deps],
+                dep_policy_of => {'include' => $TARGET->POLICY_CAPTURE},
+                key       => $key,
+                status_of => {'include' => $TARGET->ST_UNKNOWN},
+                task      => 'install',
+            }
+        ),
+    );
+    my ($ext, $root) = $attrib_ref->{util}->file_ext($key);
+    # @{$symbols_ref} contains a list of [$type, $symbol, $symbol_parent]
+    # where $type is the program unit type
+    #       $symbol is the program unit symbol
+    #       $symbol_parent is the parent program unit symbol, e.g. name of
+    #       parent module of a submodule
+    my $symbols_ref = $source->get_info_of()->{symbols};
+    # FIXME: hard code the handling of "*.inc" files as include files
+    if (!defined($symbols_ref) || !@{$symbols_ref} || $ext eq 'inc') {
+        return @targets;
+    }
+    my $key_of_o = $TARGET_OF->($symbols_ref->[0][1], 'o');
+    my @keys_of_mod;
+    for (grep {$_->[0] eq 'module'} @{$symbols_ref}) {
+        my ($type, $symbol) = @{$_};
+        my $key_of_mod = $TARGET_OF->($symbol, 'f90-mod');
+        my @include_deps = grep {$_->[1] eq 'include'} @deps;
+        push(
+            @targets,
+            $TARGET->new(
+                {   category      => $TARGET->CT_INCLUDE,
+                    deps          => [[$key_of_o, 'o']],
+                    dep_policy_of => {
+                        'include' => $TARGET->POLICY_CAPTURE,
+                        'o'       => $TARGET->POLICY_FILTER_IMMEDIATE,
+                    },
+                    key         => $key_of_mod,
+                    task        => 'compile+',
+                }
+            )
+        );
+        push(@keys_of_mod, $key_of_mod);
+    }
+    my @symbol_parents = map {
+        scalar(@{$_}) > 2 ? $TARGET_OF->($_->[2], 'o') : ();
+    } @{$symbols_ref};
+    push(
+        @targets,
+        $TARGET->new(
+            {   category      => $TARGET->CT_O,
+                deps          => [@deps],
+                dep_policy_of => {'include' => $TARGET->POLICY_CAPTURE},
+                info_of       => {paths => [], parents => \@symbol_parents},
+                key           => $key_of_o,
+                task          => 'compile',
+                triggers      => \@keys_of_mod,
+            }
+        ),
+    );
+    if (grep {$_->[0] eq 'subroutine' || $_->[0] eq 'function'} @{$symbols_ref}) {
+        my $target_key = $root . $ext_hash_ref->{'f90-interface'};
+        push(
+            @targets,
+            $TARGET->new(
+                {   category      => $TARGET->CT_INCLUDE,
+                    deps          => [[$key_of_o, 'o'], grep {exists($_->[2])} @deps],
+                    dep_policy_of => {
+                        'include' => $TARGET->POLICY_FILTER_IMMEDIATE,
+                    },
+                    key           => $target_key,
+                    task          => 'ext-iface',
+                }
+            )
+        );
+    }
+    if ($source->get_info_of()->{main}) {
+        my @link_deps = grep {$_->[1] eq 'o' || $_->[1] eq 'o.special'} @deps;
+        push(
+            @targets,
+            $TARGET->new(
+                {   category      => $TARGET->CT_BIN,
+                    deps          => [[$key_of_o, 'o'], @link_deps],
+                    dep_policy_of => {
+                        'o'         => $TARGET->POLICY_CAPTURE,
+                        'o.special' => $TARGET->POLICY_CAPTURE,
+                    },
+                    info_of       => {
+                        paths => [], deps => {o => [], 'o.special' => []},
+                    },
+                    key           => $root . $ext_hash_ref->{bin},
+                    task          => 'link',
+                }
+            )
+        );
+    }
+    return @targets;
+}
+
+# If target's fc.flag-omp property is empty, remove !$OMP dependencies.
+# Otherwise, remove !$OMP sentinels from the dependencies.
+sub _target_deps_filter {
+    my ($attrib_ref, $target) = @_;
+    if ($target->get_prop_of()->{'fc.flag-omp'}) {
+        for my $dep_ref (@{$target->get_deps()}) {
+            if (index($dep_ref->[0], $OMP_PREFIX) == 0) {
+                substr($dep_ref->[0], 0, length($OMP_PREFIX), q{});
+            }
+        }
+    }
+    else {
+        $target->set_deps(
+            [grep {index($_->[0], $OMP_PREFIX) == -1} @{$target->get_deps()}],
+        );
+    }
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::FileType::Fortran
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::FileType::Fortran;
+    my $file_type_util = FCM::System::Make::Build::FileType::Fortran->new();
+
+    $file_type_util->source_analyse($source);
+
+    my @targets = $file_type_util->source_to_targets($m_ctx, $ctx, $source);
+
+=head1 DESCRIPTION
+
+A wrapper of
+L<FCM::System::Make::Build::FileType|FCM::System::Make::Build::FileType> with
+configurations to work with Fortran source files.
+
+=head1 TODO
+
+Combine the code with FCM::System::Make::Build::Task::ExtractInterface.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/H.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/H.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/H.pm	(revision 5095)
@@ -0,0 +1,131 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::FileType::H;
+use base qw{FCM::System::Make::Build::FileType};
+
+use FCM::Context::Make::Build;    # for FCM::Context::Make::Build::Target
+use FCM::System::Make::Build::Task::Install;
+use File::Basename qw{basename};
+
+# RE: file (base) name
+my $RE_FILE = qr{[\w\-+.]+}imsx;
+
+# Dependency types and CODE to extract them
+my %SOURCE_ANALYSE_DEP_OF = (
+    include => sub { $_[0] =~ qr{\A\#\s*include\s+"($RE_FILE)"}msx },
+
+    # Note: handle ! as a comment, for *.h files containing Fortran source
+    o => sub {
+        $_[0] =~ qr{\A\s*(?:!|/\*)\s*depends\s*on\s*:\s*($RE_FILE)}imsx;
+    },
+);
+
+# Alias
+my $TARGET = 'FCM::Context::Make::Build::Target';
+
+# Handler of tasks
+my %TASK_CLASS_OF = (install => 'FCM::System::Make::Build::Task::Install');
+
+# Property suffices of output file extensions
+my %TARGET_EXT_OF = ('o' => '.o');
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        FCM::System::Make::Build::FileType->new({
+            id                    => 'h',
+            file_ext              => '.h',
+            source_analyse_dep_of => {%SOURCE_ANALYSE_DEP_OF},
+            source_to_targets     => \&_source_to_targets,
+            target_file_ext_of    => {%TARGET_EXT_OF},
+            task_class_of         => {%TASK_CLASS_OF},
+            %{$attrib_ref},
+        }),
+        $class,
+    );
+}
+
+# Returns a list of targets for a given build source.
+sub _source_to_targets {
+    my ($attrib_ref, $source, $prop_hash_ref) = @_;
+    my %dot = %{$prop_hash_ref};
+    my $key = basename($source->get_path());
+    my @deps = map {
+        my $ext = $attrib_ref->{util}->file_ext($_->[0]);
+        $_->[1] eq 'o' && !$ext ? [lc($_->[0]) . $dot{o}, $_->[1]] : $_;
+    } @{$source->get_deps()};
+    $TARGET->new(
+        {   category => $TARGET->CT_INCLUDE,
+            deps     => [@deps],
+            dep_policy_of => {'include' => $TARGET->POLICY_CAPTURE},
+            key      => $key,
+            status_of=> {'include' => $TARGET->ST_UNKNOWN},
+            task     => 'install',
+        }
+    );
+}
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::FileType::HPP;
+use base qw{FCM::System::Make::Build::FileType::H};
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        FCM::System::Make::Build::FileType::H->new({
+            source_analyse_dep_of => {include => $SOURCE_ANALYSE_DEP_OF{include}},
+            target_file_ext_of    => {},
+            %{$attrib_ref},
+        }),
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::FileType::H
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::FileType::H;
+    my $helper = FCM::System::Make::Build::FileType::H->new();
+    $helper->source_analyse($handle);
+
+    my $helper = FCM::System::Make::Build::FileType::HPP->new();
+    $helper->source_analyse($handle);
+
+=head1 DESCRIPTION
+
+A wrapper of
+L<FCM::System::Make::Build::FileType|FCM::System::Make::Build::FileType> with
+configurations to work with C or Fortran preprocessor header files.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/NS.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/NS.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/NS.pm	(revision 5095)
@@ -0,0 +1,210 @@
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+use strict;
+use warnings;
+#-------------------------------------------------------------------------------
+
+package FCM::System::Make::Build::FileType::NS;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::Make::Build;    # for FCM::Context::Make::Build::Target
+use FCM::System::Make::Build::Task::Archive;
+use FCM::System::Make::Build::Task::Install;
+use File::Spec::Functions qw{catfile};
+
+my $ID = '/';
+
+my %TARGET_FILE_EXT_OF = (a => '.a', etc => '.etc');
+
+my %TASK_CLASS_OF = (
+    'archive' => 'FCM::System::Make::Build::Task::Archive',
+    'install' => 'FCM::System::Make::Build::Task::Install',
+);
+
+# Creates the class.
+__PACKAGE__->class(
+    {   id                 => {isa => '$', default => $ID},
+        target_file_ext_of => {isa => '%', default => {%TARGET_FILE_EXT_OF}},
+        target_file_name_option_of => '%',
+        task_class_of      => {isa => '%', default => {%TASK_CLASS_OF}},
+        shared_util_of     => '%',
+        task_of            => '%',
+        util               => '&',
+    },
+    {   init => \&_init,
+        action_of => {
+            (map {my $key = $_; ($key => sub {$_[0]->{$key}})}
+                qw{id target_file_ext_of target_file_name_option_of task_of}
+            ),
+            ns_targets_deps => sub {('o')},
+            ns_targets      => \&_ns_targets,
+        },
+    },
+);
+
+# Initialises some attributes.
+sub _init {
+    my ($attrib_ref) = @_;
+    while (my ($key, $class) = each(%{$attrib_ref->{task_class_of}})) {
+        $attrib_ref->{util}->class_load($class);
+        $attrib_ref->{task_of}{$key}
+            = $class->new({util => $attrib_ref->{util}});
+    }
+}
+
+# Returns a list of targets for a given build source.
+sub _ns_targets {
+    my ($attrib_ref, $targets_ref, $prop_hash_ref) = @_;
+    my %target_of;
+    TARGET:
+    for my $target (@{$targets_ref}) {
+        my @ns_targets;
+        for (
+            [sub {!$_[0]->get_type()}          , \&_ns_target_new_etc],
+            [sub {$_[0]->get_category() eq 'o'}, \&_ns_target_new_lib],
+        ) {
+            my ($test, $new) = @{$_};
+            if ($test->($target)) {
+                my $ns_iter = $attrib_ref->{util}->ns_iter(
+                    $target->get_ns(), $attrib_ref->{util}->NS_ITER_UP,
+                );
+                $ns_iter->(); # discard
+                while (defined(my $ns = $ns_iter->())) {
+                    my $ns_target = $new->($ns, $prop_hash_ref);
+                    my $key = $ns_target->get_key();
+                    if (!exists($target_of{$key})) {
+                        $target_of{$key} = $ns_target;
+                    }
+                    push(
+                        @{$target_of{$key}->get_deps()},
+                        [$target->get_key(), $target->get_category()],
+                    );
+                }
+                next TARGET;
+            }
+        }
+    }
+    values(%target_of);
+}
+
+# Returns a new etc target for building data files in a namespace.
+sub _ns_target_new_etc {
+    my ($ns, $prop_hash_ref) = @_;
+    my $DOT_ETC = $prop_hash_ref->{etc};
+    my $TARGET = 'FCM::Context::Make::Build::Target';
+    $TARGET->new(
+        {   category      => $TARGET->CT_ETC,
+            dep_policy_of => {'etc' => $TARGET->POLICY_CAPTURE},
+            key           => ($ns ? catfile($ns, $DOT_ETC) : $DOT_ETC),
+            ns            => $ns,
+            task          => 'install',
+        }
+    );
+}
+
+# Returns a new archive target for building an object library for a namespace.
+sub _ns_target_new_lib {
+    my ($ns, $prop_hash_ref) = @_;
+    my $NAME = 'libo' . $prop_hash_ref->{a}; # FIXME: libo hard-coded
+    my $TARGET = 'FCM::Context::Make::Build::Target';
+    $TARGET->new(
+        {   category      => $TARGET->CT_LIB,
+            dep_policy_of => {'o' => $TARGET->POLICY_CAPTURE},
+            info_of       => {paths => [], deps => {o => []}},
+            key           => ($ns ? catfile($ns, $NAME) : $NAME),
+            ns            => $ns,
+            task          => 'archive',
+        }
+    );
+}
+
+#-------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::FileType::NS
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::FileType::NS;
+    my $file_type_util = FCM::System::Make::Build::FileType->new(\%attrib);
+    $file_type_util->ns_targets($m_ctx, $ctx, @targets);
+
+=head1 DESCRIPTION
+
+Generates name space level targets.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Creates and returns a new instance.
+
+=item $instance->id()
+
+Returns the recommended ID of this file type.
+
+=item $instance->ns_targets(\@targets,\%prop_of)
+
+Using the information in the original list of targets, creates and returns the
+contexts of a list of extra targets based on the name spaces of the original
+list. In the current settings, a target with no type (i.e. a data file target)
+will generate a C<.etc> target for the container name spaces; a target in the
+C<o> category will generate a C<libo.a> target for the container name spaces.
+
+=item $instance->ns_targets_deps()
+
+Returns a list of dependency types used by
+$instance->ns_targets(\@targets,\%prop_of).
+
+=item $instance->target_file_ext_of()
+
+Returns a HASH reference containing a map between the named types of file
+extensions used by the $instance->ns_targets(\@targets,\%prop_of) method
+and their default values.
+
+=item $instance->target_file_name_option_of()
+
+Returns a HASH reference containing a map between the named types of files
+used by the $instance->source_to_targets($source,\%prop_of) method
+and their default settings for other file naming options.
+
+=item $instance->task_of()
+
+Returns a HASH reference containing a map between the named tasks for this file
+type and their implementation objects. Each task should have a
+$task->main($target) method to update a target and optionally a $task->prop_of()
+method to return a HASH reference containing a map between the named properties
+used by the task and their default values.
+
+=back
+
+=head1 TODO
+
+The configuration in this module is a bit hard coded. It can do with a refactor.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/Script.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/Script.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/FileType/Script.pm	(revision 5095)
@@ -0,0 +1,100 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::FileType::Script;
+use base qw{FCM::System::Make::Build::FileType};
+
+use FCM::Context::Make::Build;    # for FCM::Context::Make::Build::Target
+use FCM::System::Make::Build::Task::Install;
+use File::Basename qw{basename};
+
+# RE: file (base) name
+my $RE_FILE = qr{[\w\-+.]+}imsx;
+
+# Dependency types and CODE to extract them
+my %SOURCE_ANALYSE_DEP_OF
+    = (bin => sub { $_[0] =~ qr{\A\s*(?:\#|;)\s*calls\s*:\s*($RE_FILE)}imsx });
+
+# Alias
+my $TARGET = 'FCM::Context::Make::Build::Target';
+
+# Handler of tasks
+my %TASK_CLASS_OF = (install => 'FCM::System::Make::Build::Task::Install');
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    $attrib_ref->{dest_keys} ||= [$TARGET->CT_INCLUDE, 'o', 'o.special'];
+    my $SOURCE_TO_TARGETS
+        = sub {_source_to_targets($attrib_ref->{dest_keys}, @_)};
+    bless(
+        FCM::System::Make::Build::FileType->new({
+            id                    => 'script',
+            file_she              => q{}, # Value not used, for file type match
+            file_ext              => q{},
+            source_analyse_dep_of => {%SOURCE_ANALYSE_DEP_OF},
+            source_to_targets     => \&_source_to_targets,
+            task_class_of         => {%TASK_CLASS_OF},
+            %{$attrib_ref},
+        }),
+        $class,
+    );
+}
+
+# Returns a list of targets for a given build source.
+sub _source_to_targets {
+    my ($attrib_ref, $source, $prop_hash_ref) = @_;
+    my $key = basename($source->get_path());
+    $TARGET->new(
+        {   category      => $TARGET->CT_BIN,
+            deps          => [@{$source->get_deps()}],
+            dep_policy_of => {'bin', $TARGET->POLICY_CAPTURE},
+            key           => $key,
+            task          => 'install',
+        }
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::FileType::Script
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::FileType::Script;
+    my $helper = FCM::System::Make::Build::FileType::Script->new();
+    $helper->source_analyse($handle);
+
+=head1 DESCRIPTION
+
+A wrapper of
+L<FCM::System::Make::Build::FileType|FCM::System::Make::Build::FileType>
+with configurations to work with some UKMO script files.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Archive.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Archive.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Archive.pm	(revision 5095)
@@ -0,0 +1,133 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Archive;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::Event;
+use FCM::System::Exception;
+use File::Spec::Functions qw{abs2rel catfile};
+use List::Util qw{first};
+use Text::ParseWords qw{shellwords};
+
+our %PROP_OF = (ar => 'ar', 'ar.flags' => 'rs');
+my $E = 'FCM::System::Exception';
+
+__PACKAGE__->class(
+    {prop_of => {isa => '%', default => {%PROP_OF}}, util => '&'},
+    {action_of => {main => \&_main, prop_of => sub {\%PROP_OF}}},
+);
+
+sub _main {
+    my ($attrib_ref, $target) = @_;
+    # Selects the correct dependent objects
+    my @paths = @{$target->get_info_of('paths')};
+    my %dep_keys_of = %{$target->get_info_of('deps')};
+    my @paths_of_o = ();
+    my $abs2rel_func
+        = sub {index($_[0], $paths[0]) == 0 ? abs2rel($_[0], $paths[0]) : $_[0]};
+    while (my ($type, $key_list_ref) = each(%dep_keys_of)) {
+        for my $key (@{$key_list_ref}) {
+            my $path = first {-e} map {catfile($_, 'o', $key)} @paths;
+            if ($path) {
+                push(@paths_of_o, $abs2rel_func->($path));
+            }
+        }
+    }
+    my @command_list = (
+        (map {shellwords($target->get_prop_of($_))} qw{ar ar.flags}),
+        $target->get_path(),
+        @paths_of_o,
+    );
+    my %value_of = %{$attrib_ref->{util}->shell_simple(\@command_list)};
+    if ($value_of{rc}) {
+        return $E->throw(
+            $E->SHELL, {command_list => \@command_list, %value_of}, $value_of{e},
+        );
+    }
+    $attrib_ref->{util}->event(
+        FCM::Context::Event->MAKE_BUILD_SHELL_OUT, @value_of{qw{o e}},
+    );
+    $target;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Archive
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Archive;
+    my $build_task = FCM::System::Make::Build::Task::Archive->new(\%attrib);
+    $build_task->main($target);
+
+=head1 DESCRIPTION
+
+Invokes the archive to create the target archive library.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Creates and returns a new instance. %attrib should contain:
+
+=over 4
+
+=item {prop_of}
+
+A HASH that maps the property names (used by this task) to their default values.
+
+=item {util}
+
+An instance of L<FCM::Util|FCM::Util>.
+
+=back
+
+=item $instance->main($target)
+
+Invokes the "ar" command to create the $target object archive. It uses the
+$target->get_info_of('deps')->{o} ARRAY. All "o" dependency items are placed in
+the archive.
+
+=item $instance->prop_of()
+
+Returns the HASH that maps the property names (used by this task) to their
+default values.
+
+=back
+
+=head1 CONSTANTS
+
+=item %FCM::System::Make::Build::Task::Archive::PROP_OF
+
+A map containing the property names and their default values.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Compile.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Compile.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Compile.pm	(revision 5095)
@@ -0,0 +1,143 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+use FCM::System::Exception;
+my $E = 'FCM::System::Exception';
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Compile;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::Event;
+use FCM::System::Make::Build::Task::Share qw{_props_to_opts};
+use File::Spec::Functions qw{abs2rel catfile};
+use Text::ParseWords qw{shellwords};
+
+__PACKAGE__->class(
+    {name => '$', prop_of => '&', util => '&'},
+    {action_of => {main => \&_main, prop_of => \&_prop_of}},
+);
+
+sub _main {
+    my ($attrib_ref, $target) = @_;
+    my $NAME  = $attrib_ref->{name};
+    my $P     = sub {scalar($target->get_prop_of($_[0]))};
+    my @paths = @{$target->get_info_of('paths')};
+    my $abs2rel_func
+        = sub {index($_[0], $paths[0]) == 0 ? abs2rel($_[0], $paths[0]) : $_[0]};
+    my @include_paths
+        = map {catfile(($_ eq $paths[0] ? q{.} : $_), 'include')} @paths;
+    my %opt_of = (
+        c   => $P->($NAME . '.flag-compile'),
+        D   => $P->($NAME . '.flag-define'),
+        I   => $P->($NAME . '.flag-include'),
+        M   => $P->($NAME . '.flag-module'),    # FIXME
+        o   => $P->($NAME . '.flag-output'),
+    );
+    my @command_list = (
+        shellwords($P->($NAME)),
+        _props_to_opts($opt_of{o}, $abs2rel_func->($target->get_path())),
+        $opt_of{c},
+        _props_to_opts($opt_of{D}, shellwords($P->($NAME .  '.defs'))),
+        _props_to_opts($opt_of{I}, @include_paths),
+        _props_to_opts($opt_of{I}, shellwords($P->($NAME .  '.include-paths'))),
+        _props_to_opts($opt_of{M}, @include_paths),
+        shellwords($P->($NAME . '.flag-omp')),
+        shellwords($P->($NAME . '.flags')),
+        $target->get_path_of_source(),
+    );
+    my %value_of = %{$attrib_ref->{util}->shell_simple(\@command_list)};
+    if ($value_of{rc}) {
+        return $E->throw(
+            $E->SHELL, {command_list => \@command_list, %value_of}, $value_of{e},
+        );
+    }
+    $attrib_ref->{util}->event(
+        FCM::Context::Event->MAKE_BUILD_SHELL_OUT, @value_of{qw{o e}},
+    );
+    $target;
+}
+
+sub _prop_of {
+    my ($attrib_ref) = @_;
+    $attrib_ref->{prop_of}->(@_);
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Compile
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Compile;
+    my $build_task = FCM::System::Make::Build::Task::Compile->new(\%attrib);
+    $build_task->main($target);
+
+=head1 DESCRIPTION
+
+Invokes the compiler command on the source of a target to generate the path of
+the target.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Creates and returns a new instance. %attrib should contain:
+
+=over 4
+
+=item {name}
+
+The property name of the compiler command.
+
+=item {prop_of}
+
+A CODE to implement the $instance->prop_of($target) method.
+
+=item {util}
+
+An instance of L<FCM::Util|FCM::Util>.
+
+=back
+
+=item $instance->main($target)
+
+Invokes the compiler command in a shell to compile the source path of the
+$target into an object file in the path of the $target.
+
+=item $instance->prop_of($target)
+
+Returns the HASH that maps the property names (used by this task) to their
+default values.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Compile/C.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Compile/C.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Compile/C.pm	(revision 5095)
@@ -0,0 +1,70 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Compile::C;
+use base qw{FCM::System::Make::Build::Task::Compile};
+
+our %PROP_OF = (
+    'cc'               => 'gcc',
+    'cc.defs'          => '',
+    'cc.flags'         => '',
+    'cc.flag-compile'  => '-c',
+    'cc.flag-define'   => '-D%s',
+    'cc.flag-include'  => '-I%s',
+    'cc.flag-omp'      => '',
+    'cc.flag-output'   => '-o%s',
+    'cc.include-paths' => '',
+);
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        $class->SUPER::new(
+            {name => 'cc', prop_of => sub {return {%PROP_OF}}, %{$attrib_ref}},
+        ),
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Compile::C
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Compile::C;
+    my $task = FCM::System::Make::Build::Task::Compile::C->new(\%attrib);
+    $task->main($target);
+
+=head1 DESCRIPTION
+
+Wraps L<FCM::System::Make::Build::Task::Compile> to compile a C source into an
+object.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Compile/CXX.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Compile/CXX.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Compile/CXX.pm	(revision 5095)
@@ -0,0 +1,70 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Compile::CXX;
+use base qw{FCM::System::Make::Build::Task::Compile};
+
+our %PROP_OF = (
+    'cxx'               => 'g++',
+    'cxx.defs'          => '',
+    'cxx.flags'         => '',
+    'cxx.flag-compile'  => '-c',
+    'cxx.flag-define'   => '-D%s',
+    'cxx.flag-include'  => '-I%s',
+    'cxx.flag-omp'      => '',
+    'cxx.flag-output'   => '-o%s',
+    'cxx.include-paths' => '',
+);
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        $class->SUPER::new(
+            {name => 'cxx', prop_of => sub {return {%PROP_OF}}, %{$attrib_ref}},
+        ),
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Compile::CXX
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Compile::CXX;
+    my $task = FCM::System::Make::Build::Task::Compile::CXX->new(\%attrib);
+    $task->main($target);
+
+=head1 DESCRIPTION
+
+Wraps L<FCM::System::Make::Build::Task::Compile> to compile a C++ source into an
+object.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Compile/Fortran.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Compile/Fortran.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Compile/Fortran.pm	(revision 5095)
@@ -0,0 +1,114 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Compile::Fortran;
+use base qw{FCM::System::Make::Build::Task::Compile};
+
+our %PROP_NO_PREPROCESS_OF = (
+    'fc'               => 'gfortran',
+    'fc.flags'         => '',
+    'fc.flag-compile'  => '-c',
+    'fc.flag-include'  => '-I%s',
+    'fc.flag-module'   => '',
+    'fc.flag-omp'      => '',
+    'fc.flag-output'   => '-o%s',
+    'fc.include-paths' => '',
+);
+
+our %PROP_OF = (
+    %PROP_NO_PREPROCESS_OF,
+    'fc.defs'          => '',
+    'fc.flag-define'   => '-D%s',
+);
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        $class->SUPER::new(
+            {name => 'fc', prop_of => \&_prop_of, %{$attrib_ref}},
+        ),
+        $class,
+    );
+}
+
+sub _prop_of {
+    my ($attrib_ref, $target) = @_;
+    if (!defined($target)) {
+        return {%PROP_OF};
+    }
+    my $file_ext = $attrib_ref->{util}->file_ext($target->get_path_of_source());
+    (lc($file_ext) eq $file_ext) ? {%PROP_NO_PREPROCESS_OF} : {%PROP_OF};
+}
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Compile::Fortran::Extra;
+use base qw{FCM::Class::CODE};
+
+use FCM::System::Exception;
+use File::Basename qw{basename};
+
+my $E = 'FCM::System::Exception';
+
+our %PROP_OF = %FCM::System::Make::Build::Task::Compile::Fortran::PROP_OF;
+
+__PACKAGE__->class(
+    {prop_of => {isa => '%', default => {%PROP_OF}}},
+    {action_of => {main => \&_main, prop_of => sub {\%PROP_OF}}},
+);
+
+sub _main {
+    my ($attrib_ref, $target) = @_;
+    my ($source, $dest) = (basename($target->get_key()), $target->get_path());
+    if (!-e $source) {
+        return;
+    }
+    rename($source, $dest) || return $E->throw($E->COPY, [$source, $dest], $!);
+    $target;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Compile::Fortran
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Compile::Fortran;
+    my $task = FCM::System::Make::Build::Task::Compile::Fortran->new(\%attrib);
+    $task->main($target);
+
+=head1 DESCRIPTION
+
+Wraps L<FCM::System::Make::Build::Task::Compile> to compile a Fortran source into
+an object.
+
+The module also provides the
+FCM::System::Make::Build::Task::Compile::Fortran::Extra class to deal with the
+module definition file generated by the compiler in the working directory.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/ExtractInterface.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/ExtractInterface.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/ExtractInterface.pm	(revision 5095)
@@ -0,0 +1,536 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::ExtractInterface;
+use base qw{FCM::Class::CODE};
+
+use FCM::System::Exception;
+use Text::Balanced qw{extract_bracketed extract_delimited};
+use Text::ParseWords qw{shellwords};
+
+# Alias
+my $E = 'FCM::System::Exception';
+
+# Regular expressions
+my $RE_ATTR = qr{
+    allocatable|dimension|external|intent|optional|parameter|pointer|save|target
+}imsx;
+my $RE_FILE = qr{[\w\-+.]+}imsx;
+my $RE_NAME = qr{[A-Za-z]\w*}imsx;
+my $RE_SPEC = qr{
+    character|class|complex|double\s*complex|double\s*precision|integer|
+    logical|procedure|real|type
+}imsx;
+my $RE_UNIT_BASE = qr{block\s*data|module|program|submodule}imsx;
+my $RE_UNIT_CALL = qr{function|subroutine}imsx;
+my $RE_UNIT      = qr{$RE_UNIT_BASE|$RE_UNIT_CALL}msx;
+my %RE           = (
+    COMMENT     => qr{\A\s*(?:!|\z)}msx,
+    COMMENT_END => qr{\A([^'"]*?)\s*!.*\z}msx,
+    CONT        => qr{\A(.*)&\s*\z}msx,
+    CONT_LEAD   => qr{\A(\s*&)(.*)\z}msx,
+    INCLUDE     => qr{(?:\#|\s*)include\s*}imsx,
+    NAME_COMP   => qr{\b($RE_NAME)(?:\s*\%\s*$RE_NAME)*\b}msx,
+    NAME_LEAD   => qr{\A\s*$RE_NAME\s*}msx,
+    NAME_LIST   => qr{\A(?:.*?)\s*,\s*($RE_NAME)\b(.*)\z}msx,
+    QUOTE       => qr{\A[^'"]*(['"])}msx,
+    TYPE_ATTR   => qr{\A\s*($RE_ATTR)\b}msx,
+    TYPE_SPEC   => qr{\A\s*($RE_SPEC)\b}msx,
+    UNIT_ATTR   => qr{\A\s*(?:(?:(?:impure\s+)?elemental|recursive|pure)\s+)+(.*)\z}imsx,
+    UNIT_BASE   => qr{\A\s*($RE_UNIT_BASE)\s+($RE_NAME)\s*\z}imsx,
+    UNIT_CALL   => qr{\A\s*($RE_UNIT_CALL)\s+($RE_NAME)\b}imsx,
+    UNIT_END  => qr{\A\s*(end)(?:\s+($RE_NAME)(?:\s+($RE_NAME))?)?\s*\z}imsx,
+    UNIT_SPEC => qr{\A\s*$RE_SPEC\b(.*)\z}imsx,
+);
+
+# Keywords in type declaration statements
+my %TYPE_DECL_KEYWORD_SET = map { ($_, 1) } qw{
+    allocatable
+    asynchronous
+    contiguous
+    dimension
+    external
+    in
+    inout
+    intent
+    kind
+    len
+    optional
+    out
+    parameter
+    pointer
+    save
+    target
+    value
+    volatile
+};
+
+__PACKAGE__->class({util => '&'}, {action_of => {main => \&_main}});
+
+sub _main {
+    my ($attrib_ref, $target) = @_;
+    my $handle
+        = $attrib_ref->{util}->file_load_handle($target->get_path_of_source());
+    eval {
+        $attrib_ref->{util}->file_save(
+            $target->get_path(),
+            [   map { s{\s+}{ }gmsx; s{\s+\z}{\n}msx; $_ }
+                    map { @{$_->{lines}} }
+                    @{_reduce_to_interface(_extract_statements($handle))}
+            ],
+        );
+    };
+    if ($@) {
+        my $e = $@;
+        if ($E->caught($e) && $e->get_code() eq $E->BUILD_SOURCE_SYN) {
+            unshift(@{$e->get_ctx()}, $target->get_path_of_source());
+        }
+        die($e);
+    }
+    close($handle);
+    $target;
+}
+
+# Reads $handle for the next Fortran statement, handling continuations.
+sub _extract_statements {
+    my ($handle) = @_;
+    my $context = {signature_token_set_of => {}, statements => []};
+    my $state = {
+        in_contains  => undef,
+        in_interface => undef,
+        in_quote     => undef,
+        in_type      => undef,
+        stack        => [],
+    };
+    my $NEW_STATEMENT = sub {
+        {   name        => q{},
+            lines       => [],
+            line_number => 0,
+            symbol      => q{},
+            type        => q{},
+            value       => q{},
+        };
+    };
+    my $statement;
+LINE:
+    while (my $line = readline($handle)) {
+        if (!defined($statement)) {
+            $statement = $NEW_STATEMENT->();
+        }
+        my $value = $line;
+        chomp($value);
+        if (!$statement->{line_number} && index($value, '#') == 0) {
+            $statement->{line_number} = $.;
+            $statement->{name}        = 'cpp';
+        }
+        if ($statement->{name} eq 'cpp') {
+            push(@{$statement->{lines}}, $line);
+            $statement->{value} .= $value;
+            if (rindex($value, '\\') != length($value) - 1) {
+                #push(@{$context->{statements}}, $statement);
+                $statement = undef;
+            }
+            next LINE;
+        }
+        if ($value =~ $RE{COMMENT}) {
+            next LINE;
+        }
+        if (!$statement->{line_number}) {
+            $statement->{line_number} = $.;
+        }
+        my ($cont_head, $cont_tail);
+        if ($statement->{line_number} != $.) {    # is a continuation
+            ($cont_head, $cont_tail) = $value =~ $RE{CONT_LEAD};
+            if ($cont_head) {
+                $value = $cont_tail;
+            }
+        }
+        my ($head, $tail) = (q{}, $value);
+        if ($state->{in_quote} && index($value, $state->{in_quote}) >= 0) {
+            my $index = index($value, $state->{in_quote});
+            $head = substr($value, 0, $index + 1);
+            $tail
+                = length($value) > $index + 1
+                ? substr($value, $index + 2)
+                : q{};
+            $state->{in_quote} = undef;
+        }
+        if (!$state->{in_quote}) {
+            while ($tail) {
+                if (index($tail, q{!}) >= 0) {
+                    if (!($tail =~ s/$RE{COMMENT_END}/$1/)) {
+                        ($head, $tail, $state->{in_quote})
+                            = _extract_statement_quote($head, $tail);
+                    }
+                }
+                else {
+                    while (index($tail, q{'}) > 0
+                        || index($tail, q{"}) > 0)
+                    {
+                        ($head, $tail, $state->{in_quote})
+                            = _extract_statement_quote($head, $tail);
+                    }
+                    $head .= $tail;
+                    $tail = q{};
+                }
+            }
+        }
+        $cont_head ||= q{};
+        push(@{$statement->{lines}}, $cont_head . $head . $tail . "\n");
+        $statement->{value} .= $head . $tail;
+        if (!($statement->{value} =~ s/$RE{CONT}/$1/)) {
+            $statement->{value} =~ s{\s+\z}{}msx;
+            if (_process($statement, $context, $state)) {
+                push(@{$context->{statements}}, $statement);
+            }
+            $statement = undef;
+        }
+    }
+    return $context;
+}
+
+# Helper, removes a quoted string from $tail.
+sub _extract_statement_quote {
+    my ($head, $tail) = @_;
+    my ($extracted, $remainder, $prefix)
+        = extract_delimited($tail, q{'"}, qr{[^'"]*}msx, q{});
+    if ($extracted) {
+        return ($head . $prefix . $extracted, $remainder);
+    }
+    else {
+        my ($quote) = $tail =~ $RE{QUOTE};
+        return ($head . $tail, q{}, $quote);
+    }
+}
+
+# Read a statement and put attributes into $statement
+sub _process {
+    my ($statement, $context, $state) = @_;
+    my $name;
+
+    # End Interface
+    if ($state->{in_interface}) {
+        if ($statement->{value} =~ qr{\A\s*end\s*interface\b}imsx) {
+            $state->{in_interface} = 0;
+        }
+        return;
+    }
+
+    # End Program Unit
+    if (@{$state->{stack}} && $statement->{value} =~ qr{\A\s*end\b}imsx) {
+        my ($end, $type, $symbol) = lc($statement->{value}) =~ $RE{UNIT_END};
+        if (!$end) {
+            return;
+        }
+        my ($top_type, $top_symbol) = @{$state->{stack}->[-1]};
+        if (!$type
+            || $top_type eq $type && (!$symbol || $top_symbol eq $symbol))
+        {
+            pop(@{$state->{stack}});
+            if ($state->{in_contains} && !@{$state->{stack}}) {
+                $state->{in_contains} = 0;
+            }
+            if (!$state->{in_contains}) {
+                $statement->{name}   = $top_type;
+                $statement->{symbol} = $top_symbol;
+                $statement->{type}   = 'end';
+                return $statement;
+            }
+        }
+        return;
+    }
+
+    # Interface/Contains
+    if ($statement->{value} =~ qr{\A\s*contains\b}imsx) {
+        $state->{'in_contains'} = 1;
+        return;
+    }
+    if ($statement->{value} =~ qr{\A\s*(?:abstract\s+)?interface\b}imsx) {
+        $state->{'in_interface'} = 1;
+        return;
+    }
+
+    # Program Unit
+    my ($type, $symbol, @tokens) = _process_prog_unit($statement->{value});
+    if ($type) {
+        push(@{$state->{stack}}, [$type, $symbol]);
+        if ($state->{in_contains}) {
+            return;
+        }
+        $statement->{name}   = lc($type);
+        $statement->{type}   = 'signature';
+        $statement->{symbol} = lc($symbol);
+        $context->{signature_token_set_of}{$symbol}
+            = {map { (lc($_) => 1) } @tokens};
+        return $statement;
+    }
+    if ($state->{in_contains}) {
+        return;
+    }
+
+    # Use
+    if ($statement->{value} =~ qr{\A\s*(use)\b}imsx) {
+        $statement->{name} = 'use';
+        $statement->{type} = 'use';
+        return $statement;
+    }
+
+    # Type Declarations
+    ($name) = $statement->{value} =~ $RE{TYPE_SPEC};
+    if ($name) {
+        $name =~ s{\s}{}gmsx;
+        $statement->{name} = lc($name);
+        $statement->{type} = 'type';
+        return $statement;
+    }
+
+    # Attribute Statements
+    ($name) = $statement->{value} =~ $RE{TYPE_ATTR};
+    if ($name) {
+        $statement->{name} = lc($name);
+        $statement->{type} = 'attr';
+    }
+}
+
+# Parse a statement for program unit header. Returns a list containing the type,
+# the symbol and the signature tokens of the program unit.
+sub _process_prog_unit {
+    my ($string) = @_;
+    my ($type, $symbol, @args) = (q{}, q{});
+    ($type, $symbol) = $string =~ $RE{UNIT_BASE};
+    if ($type) {
+        $type = lc($type);
+        $type =~ s{\s*}{}gmsx;
+        return ($type, $symbol);
+    }
+    $string =~ s/$RE{UNIT_ATTR}/$1/;
+    my ($match) = $string =~ $RE{UNIT_SPEC};
+    if ($match) {
+        $string = $match;
+        extract_bracketed($string);
+    }
+    ($type, $symbol) = lc($string) =~ $RE{UNIT_CALL};
+    if (!$type) {
+        return;
+    }
+    my $extracted = extract_bracketed($string, q{()}, qr{[^(]*}msx);
+
+    # Get arguments/keywords from SUBROUTINE/FUNCTION
+    if ($extracted) {
+        $extracted =~ s{\s}{}gmsx;
+        @args = split(q{,}, substr($extracted, 1, length($extracted) - 2));
+        if ($type eq 'function') {
+            my $result = extract_bracketed($string, q{()}, qr{[^(]*}msx);
+            if ($result) {
+                $result =~ s{\A\(\s*(.*?)\s*\)\z}{$1}msx;    # remove braces
+                push(@args, $result);
+            }
+            else {
+                push(@args, $symbol);
+            }
+        }
+    }
+    return (lc($type), lc($symbol), map { lc($_) } @args);
+}
+
+# Reduces the list of statements to contain only the interface block.
+sub _reduce_to_interface {
+    my ($context) = @_;
+    my (%token_set, @interface_statements);
+STATEMENT:
+    for my $statement (reverse(@{$context->{statements}})) {
+        if ($statement->{type} eq 'end'
+            && grep { $_ eq $statement->{name} } qw{subroutine function})
+        {
+            push(@interface_statements, $statement);
+            %token_set
+                = %{$context->{signature_token_set_of}{$statement->{symbol}}};
+            next STATEMENT;
+        }
+        if ($statement->{type} eq 'signature'
+            && grep { $_ eq $statement->{name} } qw{subroutine function})
+        {
+            push(@interface_statements, $statement);
+            %token_set = ();
+            next STATEMENT;
+        }
+        if ($statement->{type} eq 'use') {
+            my ($head, $tail)
+                = split(qr{,\s*only\s*:\s*}msx, lc($statement->{value}), 2);
+            if ($tail) {
+                my @imports = map { [split(qr{\s*=>\s*}msx, $_, 2)] }
+                    split(qr{\s*,\s*}msx, $tail);
+                my @useful_imports
+                    = grep { exists($token_set{$_->[0]}) } @imports;
+                if (!@useful_imports) {
+                    next STATEMENT;
+                }
+                if (@imports != @useful_imports) {
+                    my @token_strings
+                        = map { $_->[0] . ($_->[1] ? ' => ' . $_->[1] : q{}) }
+                        @useful_imports;
+                    my ($last, @rest) = reverse(@token_strings);
+                    my @token_lines
+                        = (reverse(map { $_ . q{,&} } @rest), $last);
+                    push(
+                        @interface_statements,
+                        {   lines => [
+                                sprintf("%s, only:&\n", $head),
+                                (map { sprintf(" & %s\n", $_) } @token_lines),
+                            ]
+                        },
+                    );
+                    next STATEMENT;
+                }
+            }
+            push(@interface_statements, $statement);
+            next STATEMENT;
+        }
+        if ($statement->{type} eq 'attr') {
+            my ($spec, @tokens) = ($statement->{value} =~ /$RE{NAME_COMP}/g);
+            if (grep { exists($token_set{lc($_)}) } @tokens) {
+                for my $token (@tokens) {
+                    $token_set{$token} = 1;
+                }
+                push(@interface_statements, $statement);
+                next STATEMENT;
+            }
+        }
+        if ($statement->{type} eq 'type') {
+            my ($variable_string, $spec_string)
+                = reverse(split('::', lc($statement->{value}), 2));
+            if ($spec_string) {
+                $spec_string =~ s{$RE{NAME_LEAD}}{}msx;
+            }
+            else {
+                $variable_string =~ s{$RE{NAME_LEAD}}{}msx;
+                $spec_string = extract_bracketed($variable_string, '()',
+                    qr{[\s\*]*}msx);
+            }
+            my $tail = q{,} . lc($variable_string);
+            my @tokens;
+            while ($tail) {
+                if ($tail =~ qr{\A\s*['"]}msx) {
+                    my $old_tail = $tail;
+                    extract_delimited($tail, q{'"}, qr{\A[^'"]*}msx, q{});
+                    if ($old_tail eq $tail) {
+                        return $E->throw(
+                            $E->BUILD_SOURCE_SYN, [$statement->{line_number}]);
+                    }
+                }
+                elsif ($tail =~ qr{\A\s*\(}msx) {
+                    my $old_tail = $tail;
+                    extract_bracketed($tail, '()', qr{\A[^(]*}msx);
+                    if ($old_tail eq $tail) {
+                        return $E->throw(
+                            $E->BUILD_SOURCE_SYN, [$statement->{line_number}]);
+                    }
+                }
+                else {
+                    my $token;
+                    ($token, $tail) = $tail =~ $RE{NAME_LIST};
+                    if ($token && $token_set{$token}) {
+                        @tokens = ($variable_string =~ /$RE{NAME_COMP}/g);
+                        $tail = q{};
+                    }
+                }
+            }
+            if (@tokens && $spec_string) {
+                my @spec_tokens = (lc($spec_string) =~ /$RE{NAME_COMP}/g);
+                push(
+                    @tokens,
+                    (   grep { !exists($TYPE_DECL_KEYWORD_SET{$_}) }
+                            @spec_tokens
+                    ),
+                );
+            }
+            if (grep { exists($token_set{$_}) } @tokens) {
+                for my $token (@tokens) {
+                    $token_set{$token} = 1;
+                }
+                push(@interface_statements, $statement);
+                next STATEMENT;
+            }
+        }
+    }
+    if (!@interface_statements) {
+        return [];
+    }
+    [   {lines => ["interface\n"]},
+        reverse(@interface_statements),
+        {lines => ["end interface\n"]},
+    ];
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::ExtractInterface
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::ExtractInterface;
+    my $task = FCM::System::Make::Build::Task::ExtractInterface->new(\%attrib);
+    $task->main($target);
+
+=head1 DESCRIPTION
+
+Extracts the calling interfaces of top level functions and subroutines in the
+Fortran source file of the target.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Creates and returns a new instance. %attrib should contain:
+
+=over 4
+
+=item {util}
+
+An instance of L<FCM::Util|FCM::Util>.
+
+=back
+
+=item $instance->main($target)
+
+Extracts the calling interfaces of top level functions and subroutines in the
+Fortran source file of the target, and writes the results to the path of the
+target.
+
+=back
+
+=head1 ACKNOWLEDGEMENT
+
+This module is inspired by the logic developed by the European Centre
+for Medium-Range Weather Forecasts (ECMWF).
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Install.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Install.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Install.pm	(revision 5095)
@@ -0,0 +1,90 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Install;
+use base qw{FCM::Class::CODE};
+
+use FCM::System::Exception;
+use File::Copy qw{copy};
+
+my $E = 'FCM::System::Exception';
+
+__PACKAGE__->class({util => '&'}, {action_of => {main => \&_main}});
+
+sub _main {
+    my ($attrib_ref, $target) = @_;
+    my ($source, $dest) = ($target->get_path_of_source(), $target->get_path());
+    if ($source) {
+        copy($source, $dest) || return $E->throw($E->COPY, [$source, $dest], $!);
+        chmod((stat($source))[2] & oct(7777), $dest)
+            || return $E->throw($E->DEST_CREATE, $dest, $!);
+    }
+    else {
+        $attrib_ref->{util}->file_save($dest, q{});
+    }
+    $target;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Install
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Install;
+    my $build_task = FCM::System::Make::Build::Task::Install->new(\%attrib);
+    $build_task->main( $target);
+
+=head1 DESCRIPTION
+
+Copies the source of the target to its path.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Creates and returns a new instance. %attrib should contain:
+
+=over 4
+
+=item {util}
+
+An instance of L<FCM::Util|FCM::Util>.
+
+=back
+
+=item $instance->main($target)
+
+Copies the source of the target to its path.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Link.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Link.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Link.pm	(revision 5095)
@@ -0,0 +1,202 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Link;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::Event;
+use FCM::System::Exception;
+use FCM::System::Make::Build::Task::Archive;
+use FCM::System::Make::Build::Task::Share qw{_props_to_opts};
+use File::Basename qw{basename};
+use File::Path qw{mkpath rmtree};
+use File::Spec::Functions qw{abs2rel catfile};
+use File::Temp qw{tempdir};
+use List::Util qw{first};
+use Text::ParseWords qw{shellwords};
+
+my $E = 'FCM::System::Exception';
+
+our %PROP_OF = (
+    %FCM::System::Make::Build::Task::Archive::PROP_OF,
+    'ld' => '',
+    'link-without-ar' => '',
+    'keep-lib-o' => '',
+);
+
+__PACKAGE__->class(
+    {name => '$', prop_of => '%', util => '&'},
+    {action_of => {main => \&_main, prop_of => sub {$_[0]->{prop_of}}}},
+);
+
+sub _main {
+    my ($attrib_ref, $target) = @_;
+    my $NAME  = $attrib_ref->{name};
+    my $P     = sub {$target->get_prop_of($_[0])};
+    # Selects the correct dependent objects
+    my @paths = @{$target->get_info_of('paths')};
+    my %dep_keys_of = %{$target->get_info_of('deps')};
+    my %paths_of = (o => [], 'o.special' => []);
+    my $abs2rel_func
+        = sub {index($_[0], $paths[0]) == 0 ? abs2rel($_[0], $paths[0]) : $_[0]};
+    while (my ($type, $key_list_ref) = each(%dep_keys_of)) {
+        for my $key (@{$key_list_ref}) {
+            my $path = first {-e} map {catfile($_, 'o', $key)} @paths;
+            if ($path) {
+                push(@{$paths_of{$type}}, $abs2rel_func->($path));
+            }
+        }
+    }
+    my $path_of_main_o = shift(@{$paths_of{o}});
+    my @command_list_refs;
+    my %opt_of = (
+        o => $P->($NAME . '.flag-output'),
+        L => $P->($NAME . '.flag-lib-path'),
+        l => $P->($NAME . '.flag-lib'),
+    );
+    # Create an intermediate archive library
+    # (when linking multiple objects and "link-without-ar" is not set)
+    my $link_with_ar = @{$paths_of{o}} && !$P->('link-without-ar');
+    my ($keep_lib_o, $lib_o_dir, $lib_o, @o_args);
+    if ($link_with_ar) {
+        # Archive (when linking multiple objects)
+        $keep_lib_o = $P->('keep-lib-o');
+        if ($keep_lib_o) {
+            $lib_o_dir = $target->CT_LIB;
+            mkpath($lib_o_dir);
+        }
+        else {
+            $lib_o_dir = tempdir(CLEANUP => 1);
+        }
+        my $root = (
+            $attrib_ref->{util}->file_ext(basename($target->get_key())))[1];
+        $lib_o = catfile($lib_o_dir, "lib$root.a");
+        push(@command_list_refs, [
+            shellwords($P->('ar')),
+            shellwords($P->('ar.flags')),
+            $lib_o,
+            @{$paths_of{o}},
+        ]);
+        @o_args = (
+            _props_to_opts($opt_of{L}, $lib_o_dir),
+            _props_to_opts($opt_of{l}, $root),
+        );
+    }
+    else {
+        @o_args = @{$paths_of{o}};
+    }
+    # Link
+    push(@command_list_refs, [
+        ($P->('ld') ? shellwords($P->('ld')) : shellwords($P->($NAME))),
+        _props_to_opts($opt_of{o}, $abs2rel_func->($target->get_path())),
+        $path_of_main_o,
+        @{$paths_of{'o.special'}},
+        @o_args,
+        _props_to_opts($opt_of{L}, shellwords($P->($NAME .  '.lib-paths'))),
+        _props_to_opts($opt_of{l}, shellwords($P->($NAME .  '.libs'))),
+        shellwords($P->($NAME . '.flag-omp')),
+        shellwords($P->($NAME . '.flags-ld')),
+    ]);
+    for my $command_list_ref (@command_list_refs) {
+        my %value_of = %{$attrib_ref->{util}->shell_simple($command_list_ref)};
+        if ($value_of{rc}) {
+            return $E->throw(
+                $E->SHELL,
+                {command_list => $command_list_ref, %value_of},
+                $value_of{e},
+            );
+        }
+        $attrib_ref->{util}->event(
+            FCM::Context::Event->MAKE_BUILD_SHELL_OUT, @value_of{qw{o e}},
+        );
+    }
+    if ($link_with_ar && !$keep_lib_o) {
+        unlink($lib_o);
+        rmtree($lib_o_dir);
+    }
+    $target;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Link
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Link;
+    my $build_task = FCM::System::Make::Build::Task::Link->new(\%attrib);
+    $build_task->main($target);
+
+=head1 DESCRIPTION
+
+Invokes the linker to create the target executable.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Creates and returns a new instance. %attrib should contain:
+
+=over 4
+
+=item {name}
+
+The property name of the linker.
+
+=item {prop_of}
+
+A HASH to map the property names (used by this task) to their default values.
+
+=item {util}
+
+An instance of L<FCM::Util|FCM::Util>.
+
+=back
+
+=item $instance->main($target)
+
+Invokes the linker to create the $target executable. It uses the
+$target->get_info_of('deps')->{o} ARRAY and
+$target->get_info_of('deps')->{"o.special"} ARRAY as dependencies. The first
+type "o" dependency item is expected to be the object file containing the main
+program. All other "o" dependency items are placed in a temporary archive
+before invoking the linker command. The main object and "o.special" dependency
+items are entered into the command line of the linker to produce the
+executable.
+
+=item $instance->prop_of()
+
+Returns the HASH that maps the property names (used by this task) to their
+default values.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Link/C.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Link/C.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Link/C.pm	(revision 5095)
@@ -0,0 +1,72 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Link::C;
+use base qw{FCM::System::Make::Build::Task::Link};
+
+use FCM::System::Make::Build::Task::Compile::C;
+
+our %PROP_OF = (
+    %FCM::System::Make::Build::Task::Link::PROP_OF,
+    (   map {$_ => $FCM::System::Make::Build::Task::Compile::C::PROP_OF{$_}}
+        qw{cc cc.flag-omp cc.flag-output}
+    ),
+    'cc.flags-ld'      => '',
+    'cc.flag-lib'      => '-l%s',
+    'cc.flag-lib-path' => '-L%s',
+    'cc.libs'          => '',
+    'cc.lib-paths'     => '',
+);
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        $class->SUPER::new(
+            {name => 'cc', prop_of => {%PROP_OF}, %{$attrib_ref}},
+        ),
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Link::C
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Link::C;
+    my $task = FCM::System::Make::Build::Task::Link::C->new(\%attrib);
+    $task->main($target);
+
+=head1 DESCRIPTION
+
+Wraps L<FCM::System::Make::Build::Task::Link> to link a C object into an
+executable.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Link/CXX.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Link/CXX.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Link/CXX.pm	(revision 5095)
@@ -0,0 +1,72 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Link::CXX;
+use base qw{FCM::System::Make::Build::Task::Link};
+
+use FCM::System::Make::Build::Task::Compile::CXX;
+
+our %PROP_OF = (
+    %FCM::System::Make::Build::Task::Link::PROP_OF,
+    (   map {$_ => $FCM::System::Make::Build::Task::Compile::CXX::PROP_OF{$_}}
+        qw{cxx cxx.flag-omp cxx.flag-output}
+    ),
+    'cxx.flags-ld'      => '',
+    'cxx.flag-lib'      => '-l%s',
+    'cxx.flag-lib-path' => '-L%s',
+    'cxx.libs'          => '',
+    'cxx.lib-paths'     => '',
+);
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        $class->SUPER::new(
+            {name => 'cxx', prop_of => {%PROP_OF}, %{$attrib_ref}},
+        ),
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Link::CXX
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Link::CXX;
+    my $task = FCM::System::Make::Build::Task::Link::CXX->new(\%attrib);
+    $task->main($target);
+
+=head1 DESCRIPTION
+
+Wraps L<FCM::System::Make::Build::Task::Link> to link a C++ object into an
+executable.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Link/Fortran.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Link/Fortran.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Link/Fortran.pm	(revision 5095)
@@ -0,0 +1,72 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Link::Fortran;
+use base qw{FCM::System::Make::Build::Task::Link};
+
+use FCM::System::Make::Build::Task::Compile::Fortran;
+
+our %PROP_OF = (
+    %FCM::System::Make::Build::Task::Link::PROP_OF,
+    (   map {$_ => $FCM::System::Make::Build::Task::Compile::Fortran::PROP_OF{$_}}
+        qw{fc fc.flag-omp fc.flag-output}
+    ),
+    'fc.flags-ld'      => '',
+    'fc.flag-lib'      => '-l%s',
+    'fc.flag-lib-path' => '-L%s',
+    'fc.libs'          => '',
+    'fc.lib-paths'     => '',
+);
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        $class->SUPER::new(
+            {name => 'fc', prop_of => {%PROP_OF}, %{$attrib_ref}},
+        ),
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Link::Fortran
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Link::Fortran;
+    my $task = FCM::System::Make::Build::Task::Link::Fortran->new(\%attrib);
+    $task->main($target);
+
+=head1 DESCRIPTION
+
+Wraps L<FCM::System::Make::Build::Task::Link> to link a Fortran object into an
+executable.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Preprocess.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Preprocess.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Preprocess.pm	(revision 5095)
@@ -0,0 +1,131 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Preprocess;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::Event;
+use FCM::System::Exception;
+use FCM::System::Make::Build::Task::Share qw{_props_to_opts};
+use File::Spec::Functions qw{catfile};
+use Text::ParseWords qw{shellwords};
+
+use FCM::System::Exception;
+
+my $E = 'FCM::System::Exception';
+
+__PACKAGE__->class(
+    {name => '$', prop_of => '%', util => '&'},
+    {action_of => {main => \&_main, prop_of => sub {$_[0]->{prop_of}}}},
+);
+
+sub _main {
+    my ($attrib_ref, $target) = @_;
+    my $NAME = $attrib_ref->{name};
+    my $P     = sub {$target->get_prop_of($_[0])};
+    my @paths = @{$target->get_info_of('paths')};
+    my @include_paths
+        = map {catfile(($_ eq $paths[0] ? q{.} : $_), 'include')} @paths;
+    my %opt_of = (
+        D => $P->($NAME . '.flag-define'),
+        I => $P->($NAME . '.flag-include'),
+    );
+    my @command = (
+        shellwords($P->($NAME)),
+        shellwords($P->($NAME . '.flags')),
+        _props_to_opts($opt_of{D}, shellwords($P->($NAME .  '.defs'))),
+        _props_to_opts($opt_of{I}, @include_paths),
+        _props_to_opts($opt_of{I}, shellwords($P->($NAME .  '.include-paths'))),
+        $target->get_path_of_source(),
+    );
+    my %value_of = %{$attrib_ref->{util}->shell_simple(\@command)};
+    if ($value_of{rc}) {
+        return $E->throw(
+            $E->SHELL, {command_list => \@command, %value_of}, $value_of{e},
+        );
+    }
+    $attrib_ref->{util}->event(
+        FCM::Context::Event->MAKE_BUILD_SHELL_OUT, undef, $value_of{e},
+    );
+    $value_of{o} ||= q{};
+    $attrib_ref->{util}->file_save($target->get_path(), $value_of{o});
+    $target;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Preprocess
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Preprocess;
+    my $build_task = FCM::System::Make::Build::Task::Preprocess->new(\%attrib);
+    $build_task->main($target);
+
+=head1 DESCRIPTION
+
+Invokes the preprocessor on the target source to generate the target.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Creates and returns a new instance. %attrib should contain:
+
+=over 4
+
+=item {name}
+
+The property name of the preprocessor.
+
+=item {prop_of}
+
+A HASH to map the property names and their default values.
+
+=item {util}
+
+An instance of L<FCM::Util|FCM::Util>.
+
+=back
+
+=item $instance->main($target)
+
+Invokes the preprocessor shell command on the target source to generate the
+target.
+
+=item $instance->prop_of()
+
+Returns the HASH that maps the property names (used by this task) to their
+default values.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Preprocess/C.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Preprocess/C.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Preprocess/C.pm	(revision 5095)
@@ -0,0 +1,66 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Preprocess::C;
+use base qw{FCM::System::Make::Build::Task::Preprocess};
+
+our %PROP_OF = (
+    'cpp'               => 'cpp',
+    'cpp.defs'          => '',
+    'cpp.flags'         => '',
+    'cpp.flag-define'   => '-D%s',
+    'cpp.flag-include'  => '-I%s',
+    'cpp.include-paths' => '',
+);
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        $class->SUPER::new(
+            {name => 'cpp', prop_of => {%PROP_OF}, %{$attrib_ref}},
+        ),
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Preprocess::C
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Preprocess::C;
+    my $task = FCM::System::Make::Build::Task::Preprocess::C->new(\%attrib);
+    $task->main($target);
+
+=head1 DESCRIPTION
+
+Wraps L<FCM::System::Make::Build::Task::Preprocess> to preprocess a C source.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Preprocess/Fortran.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Preprocess/Fortran.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Preprocess/Fortran.pm	(revision 5095)
@@ -0,0 +1,67 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Preprocess::Fortran;
+use base qw{FCM::System::Make::Build::Task::Preprocess};
+
+our %PROP_OF = (
+    'fpp'               => 'cpp',
+    'fpp.defs'          => '',
+    'fpp.flags'         => '-P -traditional',
+    'fpp.flag-define'   => '-D%s',
+    'fpp.flag-include'  => '-I%s',
+    'fpp.include-paths' => '',
+);
+
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        $class->SUPER::new(
+            {name => 'fpp', prop_of => {%PROP_OF}, %{$attrib_ref}},
+        ),
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Preprocess::Fortran
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Preprocess::Fortran;
+    my $task = FCM::System::Make::Build::Task::Preprocess::Fortran->new(\%attrib);
+    $task->main($target);
+
+=head1 DESCRIPTION
+
+Wraps L<FCM::System::Make::Build::Task::Preprocess> to preprocess a Fortran
+source.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Share.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Share.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Build/Task/Share.pm	(revision 5095)
@@ -0,0 +1,94 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Build::Task::Share;
+use base qw{Exporter};
+
+use Text::ParseWords qw{shellwords};
+
+our @EXPORT = qw{_props_to_opts};
+
+sub _props_to_opts {
+    # $opt_value should be an sprintf format with one %s.
+    my ($opt_value, @props) = @_;
+    if (!$opt_value) {
+        return;
+    }
+    my @opt_values = shellwords($opt_value);
+    my $index = -1;
+    I:
+    for my $i (0 .. $#opt_values) {
+        if (index($opt_values[$i], '%s') >= 0) {
+            $index = $i;
+            last I;
+        }
+    }
+    if ($index == -1) {
+        return (@opt_values, @props);
+    }
+    my @return;
+    for my $prop (@props) {
+        push(@return, @opt_values[0 .. $index - 1]);
+        push(@return, sprintf($opt_values[$index], $prop));
+        push(@return, @opt_values[$index + 1 .. $#opt_values]);
+    }
+    return @return;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Build::Task::Share
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Build::Task::Share
+
+=head1 DESCRIPTION
+
+Provides common "local" functions for a make build task.
+
+=head1 FUNCTIONS
+
+The following functions are automatically exported by this module.
+
+=over 4
+
+=item _props_to_opts($opt_value, @props)
+
+Expect $opt_value to be an sprintf format containing one %s, and @props is a
+list of values. Return a list that can be used in a shell command. E.g.:
+
+    _props_to_opts('-D%s', 'HELLO="greetings"', 'WORLD="mars and venus"')
+    # => ('-DHELLO="greetings"', '-DWORLD="mars and venus"')
+    
+    _props_to_opts('-I %s', '/path/1', '/path/2')
+    # => ('-I', '/path/1', '-I', '/path/2')
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Extract.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Extract.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Extract.pm	(revision 5095)
@@ -0,0 +1,1312 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Extract;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::ConfigEntry;
+use FCM::Context::Event;
+use FCM::Context::Make::Extract;
+use FCM::Context::Locator;
+use FCM::Context::Task;
+use FCM::System::Exception;
+use FCM::System::Make::Share::Subsystem;
+use File::Basename qw{dirname};
+use File::Compare qw{compare};
+use File::Copy qw{copy};
+use File::Path qw{mkpath rmtree};
+use File::Spec::Functions qw{abs2rel catfile tmpdir};
+use File::Temp;
+use List::Util qw{first};
+use Storable qw{dclone};
+
+# Aliases
+our $UTIL;
+my $E = 'FCM::System::Exception';
+
+# Configuration parser map: label to action
+our %CONFIG_PARSER_OF = (
+    'location'  => \&_config_parse_location,
+    'ns'        => \&_config_parse_ns_list,
+    'path-excl' => _config_parse_path_func(
+        sub {$_->get_path_excl()}, sub {$_->set_path_excl(@_)}, '@',
+    ),
+    'path-incl' => _config_parse_path_func(
+        sub {$_->get_path_incl()}, sub {$_->set_path_incl(@_)}, '@',
+    ),
+    'path-root' => _config_parse_path_func(
+        sub {$_->get_path_root()}, sub {$_->set_path_root(@_)},
+    ),
+);
+
+# Properties from FCM::Util
+our @UTIL_PROP_KEYS = qw{diff3 diff3.flags};
+
+# Creates the class.
+__PACKAGE__->class(
+    {   config_parser_of => {isa => '%', default => {%CONFIG_PARSER_OF}},
+        prop_of          => '%',
+        shared_util_of   => '%',
+        util             => '&',
+    },
+    {   init => \&_init,
+        action_of => {
+            config_parse              => \&_config_parse,
+            config_parse_class_prop   => \&_config_parse_class_prop,
+            config_parse_inherit_hook => \&_config_parse_inherit_hook,
+            config_unparse            => \&_config_unparse,
+            config_unparse_class_prop => \&_config_unparse_class_prop,
+            ctx                       => \&_ctx,
+            ctx_load_hook             => \&_ctx_load_hook,
+            main                      => \&_main,
+        },
+    },
+);
+
+# Initialises the helpers of the class.
+sub _init {
+    my ($attrib_ref) = @_;
+    for my $util_prop_key (@UTIL_PROP_KEYS) {
+        my $prop = $attrib_ref->{util}->external_cfg_get($util_prop_key);
+        $attrib_ref->{prop_of}{$util_prop_key} = [$prop];
+    }
+}
+
+# Reads the extract.location declaration from a config entry.
+sub _config_parse_location {
+    my ($attrib_ref, $ctx, $entry) = @_;
+    if (!@{$entry->get_ns_list()}) {
+        return $E->throw($E->CONFIG_NS, $entry);
+    }
+    my %PARSER_OF = (
+        'base'    => \&_config_parse_location_base,
+        'diff'    => \&_config_parse_location_diff,
+        'primary' => \&_config_parse_location_primary,
+    );
+    my %modifier_of = %{$entry->get_modifier_of()};
+    if (!grep {exists($modifier_of{$_})} keys(%PARSER_OF)) {
+        $modifier_of{'base'} = 1;
+    }
+    for my $key (grep {exists($modifier_of{$_})} keys(%PARSER_OF)) {
+        $PARSER_OF{$key}->($attrib_ref, $ctx, $entry);
+    }
+}
+
+# Reads the extract.location{base} declaration from a config entry.
+sub _config_parse_location_base {
+    my ($attrib_ref, $ctx, $entry) = @_;
+    my %option;
+    if (exists($entry->get_modifier_of()->{'type'})) {
+        %option = ('type' => $entry->get_modifier_of()->{'type'});
+    }
+    for my $ns (@{$entry->get_ns_list()}) {
+        if (!exists($ctx->get_project_of()->{$ns})) {
+            $ctx->get_project_of()->{$ns} = $ctx->CTX_PROJECT->new({ns => $ns});
+        }
+        my $project = $ctx->get_project_of()->{$ns};
+        if ($project->get_inherited()) {
+            if (!$entry->get_value()) {
+                return $E->throw($E->CONFIG_VALUE, $entry);
+            }
+            my $locator = FCM::Context::Locator->new(
+                $entry->get_value(), \%option,
+            );
+            if ($project->get_locator()) {
+                $attrib_ref->{util}->loc_rel2abs(
+                    $locator,
+                    $project->get_locator(),
+                );
+            }
+            $attrib_ref->{util}->loc_as_invariant($locator);
+            my $i_locator = $project->get_trees()->[0]->get_locator();
+            if ($locator->get_value() ne $i_locator->get_value()) {
+                return $E->throw($E->CONFIG_CONFLICT, $entry);
+            }
+        }
+        else {
+            if (    !exists($project->get_trees()->[0])
+                ||  !defined($project->get_trees()->[0])
+            ) {
+                $project->get_trees()->[0]
+                    = $ctx->CTX_TREE->new({key => 0, ns => $ns});
+            }
+            if ($entry->get_value()) {
+                my $locator = FCM::Context::Locator->new(
+                    $entry->get_value(), \%option,
+                );
+                $project->get_trees()->[0]->set_locator($locator);
+            }
+            else {
+                $project->get_trees()->[0] = undef;
+            }
+        }
+    }
+}
+
+# Reads the extract.location{diff} declaration from a config entry.
+sub _config_parse_location_diff {
+    my ($attrib_ref, $ctx, $entry) = @_;
+    my %option;
+    if (exists($entry->get_modifier_of()->{'type'})) {
+        %option = ('type' => $entry->get_modifier_of()->{'type'});
+    }
+    for my $ns (@{$entry->get_ns_list()}) {
+        if (!exists($ctx->get_project_of()->{$ns})) {
+            $ctx->get_project_of()->{$ns} = $ctx->CTX_PROJECT->new({ns => $ns});
+        }
+        my $project = $ctx->get_project_of()->{$ns};
+        my ($base, @diffs) = @{$project->get_trees()};
+        @diffs = grep {
+                $_->get_inherited()
+            ||      $option{type}
+                &&  $_->get_locator()->get_type()
+                &&  $option{type} ne $_->get_locator()->get_type()
+        } @diffs;
+        for my $value ($entry->get_values()) {
+            if (!$value) {
+                return $E->throw($E->CONFIG_VALUE, $entry);
+            }
+            push(
+                @diffs,
+                $ctx->CTX_TREE->new({
+                    key     => scalar(@diffs) + 1,
+                    locator => FCM::Context::Locator->new($value, \%option),
+                    ns      => $ns,
+                }),
+            );
+        }
+        @{$project->get_trees()} = ($base, @diffs);
+    }
+}
+
+# Reads the extract.location{primary} declaration from a config entry.
+sub _config_parse_location_primary {
+    my ($attrib_ref, $ctx, $entry) = @_;
+    my %option;
+    if (exists($entry->get_modifier_of()->{'type'})) {
+        %option = ('type' => $entry->get_modifier_of()->{'type'});
+    }
+    for my $ns (@{$entry->get_ns_list()}) {
+        if (!exists($ctx->get_project_of()->{$ns})) {
+            $ctx->get_project_of()->{$ns} = $ctx->CTX_PROJECT->new({ns => $ns});
+        }
+        my $project = $ctx->get_project_of()->{$ns};
+        if ($entry->get_value()) {
+            my $locator = FCM::Context::Locator->new(
+                $entry->get_value(), \%option,
+            );
+            $attrib_ref->{util}->loc_as_normalised($locator);
+            if ($project->get_inherited()) {
+                my $project_locator = $project->get_locator();
+                if ($project_locator->get_value() ne $locator->get_value()) {
+                    return $E->throw($E->CONFIG_CONFLICT, $entry);
+                }
+            }
+            else {
+                $project->set_locator($locator);
+            }
+        }
+        else {
+            $project->set_locator(undef);
+        }
+    }
+}
+
+# Reads the extract.ns declaration from a config entry.
+sub _config_parse_ns_list {
+    my ($attrib_ref, $ctx, $entry) = @_;
+    @{$ctx->get_ns_list()} = $entry->get_values();
+}
+
+# Returns a function to parse extract.path-*.
+sub _config_parse_path_func {
+    my ($getter, $setter, $isa) = @_;
+    $isa ||= '$';
+    sub {
+        my ($attrib_ref, $ctx, $entry) = @_;
+        my @ns_list
+            = @{$entry->get_ns_list()} ? @{$entry->get_ns_list()}
+            :                            @{$ctx->get_ns_list()}
+            ;
+        for my $ns (@ns_list) {
+            if (!exists($ctx->get_project_of()->{$ns})) {
+                $ctx->get_project_of()->{$ns}
+                    = $ctx->CTX_PROJECT->new({ns => $ns});
+            }
+            my $project = $ctx->get_project_of()->{$ns};
+            my $value = $entry->get_value();
+            if ($isa eq '@') {
+                $value = [map {$_ eq q{/} ? q{} : $_} $entry->get_values()];
+            }
+            local($_) = $project;
+            if ($_->get_inherited()) {
+                my $old = $getter->();
+                my $new = $value;
+                if ($isa eq '@') {
+                    $old = _config_unparse_join(@{$old});
+                    $new = _config_unparse_join(@{$new});
+                }
+                if ($old ne $new) {
+                    return $E->throw($E->CONFIG_CONFLICT, $entry);
+                }
+            }
+            else {
+                $setter->($value);
+            }
+        }
+    };
+}
+
+# A hook command for the "inherit/use" declaration.
+sub _config_parse_inherit_hook {
+    my ($attrib_ref, $ctx, $i_ctx) = @_;
+    @{$ctx->get_ns_list()} = @{$i_ctx->get_ns_list()};
+    while (my ($ns, $i_project) = each(%{$i_ctx->get_project_of()})) {
+        my $project = dclone($i_project);
+        $project->set_inherited(1);
+        for my $tree (@{$project->get_trees()}) {
+            $tree->set_inherited(1);
+        }
+        $ctx->get_project_of()->{$ns} = $project;
+    }
+    _config_parse_inherit_hook_prop($attrib_ref, $ctx, $i_ctx);
+}
+
+# Turns a context into a list of configuration entries.
+sub _config_unparse {
+    my ($attrib_ref, $ctx) = @_;
+    my %LABEL_OF
+        = map {($_ => $ctx->get_id() . q{.} . $_)} keys(%CONFIG_PARSER_OF);
+    my @entries = (
+        FCM::Context::ConfigEntry->new({
+            label => $LABEL_OF{ns},
+            value => _config_unparse_join(@{$ctx->get_ns_list()}),
+        }),
+    );
+    for my $p_ns (sort keys(%{$ctx->get_project_of()})) {
+        my $project = $ctx->get_project_of($p_ns);
+        my ($base, @diffs) = @{$project->get_trees()};
+        if (!$project->get_inherited()) {
+            if (defined($project->get_locator())) {
+                my $locator = $project->get_locator();
+                my %modifier_of = (primary => 1, type => $locator->get_type());
+                push(
+                    @entries,
+                    FCM::Context::ConfigEntry->new({
+                        label       => $LABEL_OF{location},
+                        modifier_of => \%modifier_of,
+                        ns_list     => [$p_ns],
+                        value       => $locator->get_value(),
+                    }),
+                );
+            }
+            if (@{$project->get_path_excl()}) {
+                my @values = map {$_ ? $_ : q{/}} @{$project->get_path_excl()};
+                push(
+                    @entries,
+                    FCM::Context::ConfigEntry->new({
+                        label       => $LABEL_OF{'path-excl'},
+                        ns_list     => [$p_ns],
+                        value       => _config_unparse_join(@values),
+                    }),
+                );
+            }
+            if (@{$project->get_path_incl()}) {
+                my @values = map {$_ ? $_ : q{/}} @{$project->get_path_incl()};
+                push(
+                    @entries,
+                    FCM::Context::ConfigEntry->new({
+                        label       => $LABEL_OF{'path-incl'},
+                        ns_list     => [$p_ns],
+                        value       => _config_unparse_join(@values),
+                    }),
+                );
+            }
+            if ($project->get_path_root()) {
+                push(
+                    @entries,
+                    FCM::Context::ConfigEntry->new({
+                        label      => $LABEL_OF{'path-root'},
+                        ns_list    => [$p_ns],
+                        value      => $project->get_path_root(),
+                    }),
+                );
+            }
+            my $value = $base->get_locator()->get_value();
+            push(
+                @entries,
+                FCM::Context::ConfigEntry->new({
+                    label       => $LABEL_OF{'location'},
+                    modifier_of => {type => $base->get_locator()->get_type()},
+                    ns_list     => [$p_ns],
+                    value       => $value,
+                }),
+            );
+        }
+        @diffs = grep {!$_->get_inherited()} @diffs;
+        if (@diffs) {
+            my %type_set = map {($_->get_locator()->get_type() => 1)} @diffs;
+            for my $type (sort(keys(%type_set))) {
+                my $value = _config_unparse_join(
+                    map  {$_->get_locator()->get_value()}
+                    grep {$_->get_locator()->get_type() eq $type}
+                    @diffs
+                );
+                push(
+                    @entries,
+                    FCM::Context::ConfigEntry->new({
+                        label       => $LABEL_OF{'location'},
+                        modifier_of => {diff => 1, type => $type},
+                        ns_list     => [$p_ns],
+                        value       => $value,
+                    }),
+                );
+            }
+        }
+    }
+    push(@entries, _config_unparse_prop($attrib_ref, $ctx));
+    return @entries;
+}
+
+# Returns a new context.
+sub _ctx {
+    my ($attrib_ref, $id_of_class, $id) = @_;
+    FCM::Context::Make::Extract->new({id => $id, id_of_class => $id_of_class});
+}
+
+# Hook when loading a previous ctx.
+sub _ctx_load_hook {
+    my ($attrib_ref, $old_m_ctx, $old_ctx, $old_m_dest, $old_dest) = @_;
+    my $path_mod_func = sub {
+        my ($get_func, $set_func) = @_;
+        my $path = $get_func->();
+        if (!defined($path)) {
+            return;
+        }
+        my $rel_path = abs2rel($path, $old_m_dest);
+        if (index($rel_path, '..') != 0) {
+            $set_func->(catfile($old_m_ctx->get_dest(), $rel_path));
+        }
+    };
+    while (my ($ns, $project) = each(%{$old_ctx->get_project_of()})) {
+        $path_mod_func->(
+            sub {$project->get_cache()},
+            sub {$project->set_cache(@_)},
+        );
+        for my $tree (@{$project->get_trees()}) {
+            $path_mod_func->(
+                sub {$tree->get_cache()},
+                sub {$tree->set_cache(@_)},
+            );
+            for my $source (@{$tree->get_sources()}) {
+                $path_mod_func->(
+                    sub {$source->get_cache()},
+                    sub {$source->set_cache(@_)},
+                );
+            }
+        }
+    }
+    while (my ($key, $target) = each(%{$old_ctx->get_target_of()})) {
+        $path_mod_func->(
+            sub {$target->get_path()},
+            sub {$target->set_path(@_)},
+        );
+        $path_mod_func->(
+            sub {$target->get_dests()->[0]},
+            sub {$target->get_dests()->[0] = $_[0]},
+        );
+        while (my ($ns, $source) = each(%{$target->get_source_of()})) {
+            $path_mod_func->(
+                sub {$source->get_cache()},
+                sub {$source->set_cache(@_)},
+            );
+        }
+    }
+}
+
+# The main function of this class.
+sub _main {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    local($UTIL) = $attrib_ref->{util};
+    for my $function (
+        \&_elaborate_ctx_of_project,
+        \&_elaborate_ctx_of_target,
+        \&_extract_incremental,
+        \&_project_tree_caches_update,
+        \&_symlink_handle,
+        \&_targets_update,
+    ) {
+        $function->($attrib_ref, $m_ctx, $ctx);
+    }
+}
+
+# Elaborates the context: project and tree.
+sub _elaborate_ctx_of_project {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+
+    # Reports projects that are not used
+    my @bad_ns_list;
+    while (my ($p_ns, $project) = each(%{$ctx->get_project_of()})) {
+        if (    !$project->get_inherited()
+            &&  !grep {$_ eq $p_ns} @{$ctx->get_ns_list()}
+        ) {
+            push(@bad_ns_list, $p_ns);
+        }
+    }
+    if (@bad_ns_list) {
+        return $E->throw($E->EXTRACT_NS, \@bad_ns_list);
+    }
+
+    # Determines a list of new trees
+    my $prev_m_ctx = $m_ctx->get_prev_ctx();
+    my $prev_ctx
+        = defined($prev_m_ctx) ? $prev_m_ctx->get_ctx_of($ctx->get_id())
+        :                          undef
+        ;
+    my @trees; # list of new trees
+    for my $p_ns (@{$ctx->get_ns_list()}) {
+        # Ensures the project settings are defined
+        if (!exists($ctx->get_project_of()->{$p_ns})) {
+            $ctx->get_project_of()->{$p_ns}
+                = $ctx->CTX_PROJECT->new({ns => $p_ns});
+        }
+        my $project = $ctx->get_project_of()->{$p_ns};
+        
+        # Determine the root location of the project, if possible
+        if (defined($project->get_locator())) {
+            $UTIL->loc_as_normalised($project->get_locator());
+        }
+        else {
+            my $uri = $UTIL->loc_kw_prefix() . ':' . $p_ns;
+            my $locator = FCM::Context::Locator->new($uri);
+            local($@);
+            eval {$UTIL->loc_as_normalised($locator)};
+            if (!$@) {
+                $project->set_locator($locator);
+            }
+        }
+        # Ensures base tree is defined
+        if (!@{$project->get_trees()} || !defined($project->get_trees()->[0])) {
+            if (!defined($project->get_locator())) {
+                return $E->throw($E->EXTRACT_LOC_BASE, $p_ns);
+            }
+            my $head_locator = $UTIL->loc_trunk_at_head($project->get_locator());
+            my $locator
+                = $head_locator ? $head_locator
+                :                 dclone($project->get_locator())
+                ;
+            $project->get_trees()->[0] = $ctx->CTX_TREE->new(
+                {key => 0, locator => $locator, ns => $p_ns},
+            );
+        }
+        # Determine whether there is a usable previous extract
+        my %path_excl = map {($_, 1)} @{$project->get_path_excl()};
+        my %path_incl = map {($_, 1)} @{$project->get_path_incl()};
+        my $path_root = $project->get_path_root();
+        my ($can_use_prev, $prev_project);
+        if (defined($prev_ctx) && defined($prev_ctx->get_project_of($p_ns))) {
+            $prev_project = $prev_ctx->get_project_of($p_ns);
+            my %prev_path_excl = map {($_, 1)} @{$prev_project->get_path_excl()};
+            my %prev_path_incl = map {($_, 1)} @{$prev_project->get_path_incl()};
+            my $prev_path_root = $prev_project->get_path_root();
+            $can_use_prev
+                =  $prev_ctx->get_status() eq $m_ctx->ST_OK
+                && !$UTIL->hash_cmp(\%path_excl, \%prev_path_excl, 1)
+                && !$UTIL->hash_cmp(\%path_incl, \%prev_path_incl, 1)
+                && $path_root eq $prev_path_root
+                ;
+        }
+        # Tree locators as invariant
+        TREE:
+        for my $tree (grep {!$_->get_inherited()} @{$project->get_trees()}) {
+            my $tree_locator = $tree->get_locator();
+            # Ensures that the tree locator is an absolute path
+            if (defined($project->get_locator())) {
+                $UTIL->loc_rel2abs($tree_locator, $project->get_locator());
+            }
+            # Determines invariant form of the locator of the project tree.
+            $UTIL->loc_as_invariant($tree_locator);
+        }
+        # Remove diff trees that are the same as the base tree
+        my ($base_tree, @old_diff_trees) = @{$project->get_trees()};
+        my $base_value = $base_tree->get_locator()->get_value();
+        my @new_diff_trees;
+        TREE:
+        for my $tree (@old_diff_trees) {
+            if ($base_value ne $tree->get_locator()->get_value()) {
+                push(@new_diff_trees, $tree);
+                $tree->set_key(scalar(@new_diff_trees)); # reset key (index)
+            }
+        }
+        $project->set_trees([$base_tree, @new_diff_trees]);
+        # Determine the new trees
+        TREE:
+        for my $tree (grep {!$_->get_inherited()} @{$project->get_trees()}) {
+            my $tree_locator = $tree->get_locator();
+            if (    $can_use_prev
+                &&  $tree_locator->get_value_level() >= $tree_locator->L_INVARIANT
+            ) {
+                my $prev_tree = first {
+                    $tree_locator->get_value() eq $_->get_locator()->get_value()
+                } @{$prev_project->get_trees()};
+                if ($prev_tree) {
+                    my $prev_tree_locator = $prev_tree->get_locator();
+                    $tree->set_sources($prev_tree->get_sources());
+                    if ($tree->get_key() || !$prev_tree->get_key()) {
+                        # Only safe to re-use cache if both are base trees
+                        # or for diff tree with an unchanged base tree
+                        $tree->set_cache($prev_tree->get_cache());
+                    }
+                    next TREE;
+                }
+                if (!$tree->get_key()) { # base tree changed
+                    $can_use_prev = 0;
+                }
+            }
+            push(@trees, $tree); # new tree
+        }
+    }
+
+    # Obtain source info for each new tree, using the task runner
+    if (@trees) {
+        my $timer = $UTIL->timer();
+        my $n_jobs = $m_ctx->get_option_of('jobs');
+        if ($n_jobs && $n_jobs > scalar(@trees)) {
+            $n_jobs = scalar(@trees);
+        }
+        my $elapse_tasks = 0;
+        my $runner = $UTIL->task_runner(
+            sub {_elaborate_ctx_of_project_tree($attrib_ref, $m_ctx, $ctx, @_)},
+            $n_jobs,
+        );
+        my $n = eval {
+            $runner->main(
+                # get
+                sub {
+                    if (!@trees) {
+                        return;
+                    }
+                    my $tree = shift(@trees);
+                    my $id = join(':', $tree->get_ns(), $tree->get_key());
+                    FCM::Context::Task->new({ctx => $tree, id => $id});
+                },
+                # put
+                sub {
+                    my ($task) = @_;
+                    if ($task->get_state() eq $task->ST_FAILED) {
+                        die($task->get_error());
+                    }
+                    my $ns = $task->get_ctx()->get_ns();
+                    my $key = $task->get_ctx()->get_key();
+                    my $project = $ctx->get_project_of()->{$ns};
+                    my $tree = $project->get_trees()->[$key];
+                    $tree->set_locator($task->get_ctx()->get_locator());
+                    $tree->set_sources($task->get_ctx()->get_sources());
+                    $elapse_tasks += $task->get_elapse();
+                },
+            );
+        };
+        my $e = $@;
+        $runner->destroy();
+        if ($e) {
+            die($e);
+        }
+        $UTIL->event(
+            FCM::Context::Event->MAKE_EXTRACT_RUNNER_SUMMARY,
+            'tree-sources-info-get', $n, $timer->(), $elapse_tasks,
+        );
+    }
+    $UTIL->event(
+        FCM::Context::Event->MAKE_EXTRACT_PROJECT_TREE,
+        {   map {($_ => [
+                map {$_->get_locator()}
+                    @{$ctx->get_project_of()->{$_}->get_trees()}
+            ])}
+            sort keys(%{$ctx->get_project_of()})
+        },
+    );
+}
+
+# Elaborates the context: new tree in a project.
+sub _elaborate_ctx_of_project_tree {
+    my ($attrib_ref, $m_ctx, $ctx, $tree) = @_;
+    my $project = $ctx->get_project_of()->{$tree->get_ns()};
+    my $path_root = $project->get_path_root();
+    # TODO: support regular expression or wildcards?
+    my %path_incl = map {($_ => 1)} @{$project->get_path_incl()};
+    my %path_excl = map {($_ => 1)} @{$project->get_path_excl()};
+    $UTIL->loc_find(
+        $tree->get_locator(),
+        sub {
+            my ($locator, $locator_attrib_ref) = @_;
+            if ($locator_attrib_ref->{is_dir}) {
+                return;
+            }
+            my $ns_in_tree = $locator_attrib_ref->{ns};
+            my $ns = $ns_in_tree;
+            if ($path_root) {
+                if ($path_root ne $UTIL->ns_common($path_root, $ns)) {
+                    return;
+                }
+                $ns = $ns eq $path_root ? q{}
+                    :                     substr($ns, length($path_root) + 1)
+                    ;
+            }
+            my $ns_iter_ref = $UTIL->ns_iter($ns, $UTIL->NS_ITER_UP);
+            NS:
+            while (defined(my $head = $ns_iter_ref->())) {
+                if (exists($path_incl{$head})) {
+                    last NS;
+                }
+                if (exists($path_excl{$head})) {
+                    return;
+                }
+            }
+            push(
+                @{$tree->get_sources()},
+                $ctx->CTX_SOURCE->new({
+                    key_of_tree => $tree->get_key(),
+                    locator     => $locator,
+                    ns          => $UTIL->ns_cat($tree->get_ns(), $ns),
+                    ns_in_tree  => $ns_in_tree,
+                }),
+            );
+        },
+    );
+    $tree;
+}
+
+# Elaborates the context: target.
+sub _elaborate_ctx_of_target {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    # Works out the extract sources and targets
+    my $DEST = $attrib_ref->{shared_util_of}{dest};
+    my $ns_sep = $UTIL->ns_sep();
+    while (my ($p_ns, $project) = each(%{$ctx->get_project_of()})) {
+        my ($tree_base, @trees) = @{$project->get_trees()};
+        # Sources from the base tree
+        for my $source (@{$tree_base->get_sources()}) {
+            my $ns = $source->get_ns();
+            my @paths = split($ns_sep, $ns);
+            my $dest_list_ref = $DEST->paths(
+                $m_ctx, 'target', $ctx->get_id(), @paths
+            );
+            $ctx->get_target_of()->{$ns} = $ctx->CTX_TARGET->new({
+                dests     => $dest_list_ref,
+                ns        => $ns,
+                source_of => {$tree_base->get_key() => $source},
+            });
+        }
+        my %sources_in_base
+            = map {($_->get_ns() => $_)} @{$tree_base->get_sources()};
+        # Sources from the diff trees
+        for my $tree (@trees) {
+            my $key = $tree->get_key();
+            my %sources_deleted = %sources_in_base;
+            # Handles new/modified sources
+            for my $source (@{$tree->get_sources()}) {
+                my $ns = $source->get_ns();
+                delete($sources_deleted{$ns});
+                if (exists($ctx->get_target_of()->{$ns})) {
+                    my $target = $ctx->get_target_of()->{$ns};
+                    my $base_source = $target->get_source_of()->{0};
+                    if (    $base_source->get_locator()
+                        &&  _source_eq($base_source, $source)
+                    ) {
+                        $source->set_status($source->ST_UNCHANGED);
+                    }
+                    else {
+                        # Source modified by diff tree
+                        $target->get_source_of()->{$key} = $source;
+                    }
+                }
+                else {
+                    # Source added by diff tree
+                    my @paths = split($ns_sep, $ns);
+                    my $dest_list_ref = $DEST->paths(
+                        $m_ctx, 'target', $ctx->get_id(), @paths,
+                    );
+                    $ctx->get_target_of()->{$ns} = $ctx->CTX_TARGET->new({
+                        dests     => $dest_list_ref,
+                        ns        => $ns,
+                        source_of => {
+                            0 => $ctx->CTX_SOURCE->new({
+                                key_of_tree => 0,
+                                status      => $ctx->CTX_SOURCE->ST_MISSING,
+                            }),
+                            $key => $source,
+                        },
+                    });
+                }
+            }
+            # Handle deleted sources
+            while (my ($ns) = each(%sources_deleted)) {
+                my $target = $ctx->get_target_of()->{$ns};
+                $target->get_source_of()->{$key} = $ctx->CTX_SOURCE->new({
+                    key_of_tree => $key,
+                    ns          => $ns,
+                    status      => $ctx->CTX_SOURCE->ST_MISSING,
+                });
+            }
+        }
+    }
+}
+
+# Extract: compare with previous extract.
+sub _extract_incremental {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    my $prev_m_ctx = $m_ctx->get_prev_ctx();
+    my $prev_ctx
+        = defined($prev_m_ctx) ? $prev_m_ctx->get_ctx_of($ctx->get_id())
+        :                          undef
+        ;
+    if (!defined($prev_ctx)) {
+        return;
+    }
+    my %deleted = map {($_ => 1)} keys(%{$prev_ctx->get_target_of()});
+    # Compares the sources in each target
+    TARGET:
+    while (my ($ns, $target) = each(%{$ctx->get_target_of()})) {
+        delete($deleted{$ns});
+        if (!exists($prev_ctx->get_target_of()->{$ns})) {
+            next TARGET;
+        }
+        my $prev_target = $prev_ctx->get_target_of()->{$ns};
+        my %prev_source_of = %{$prev_target->get_source_of()};
+        my %source_of = %{$target->get_source_of()};
+        if (keys(%prev_source_of) != keys(%source_of)) {
+            next TARGET;
+        }
+        while (my ($key_of_tree, $source) = each(%source_of)) {
+            if (!exists($prev_source_of{$key_of_tree})) {
+                next TARGET;
+            }
+            my $prev_source = $prev_source_of{$key_of_tree};
+            if (   $prev_source->get_status() ne $source->get_status()
+                || !$source->is_missing() && !_source_eq($prev_source, $source)
+            ) {
+                next TARGET;
+            }
+        }
+        $target->set_status_of_source($prev_target->get_status_of_source());
+        if ($prev_target->is_ok()) {
+            $target->set_path($prev_target->get_path());
+            $target->set_status($target->ST_UNCHANGED);
+        }
+    }
+    # Creates a dummy target for each deleted target
+    my $ns_sep = $UTIL->ns_sep();
+    while (my $ns = each(%deleted)) {
+        my $target = $prev_ctx->get_target_of($ns);
+        if ($target->get_status() ne $target->ST_DELETED) {
+            my @paths = split($ns_sep, $ns);
+            my $dest_list_ref = $attrib_ref->{shared_util_of}{dest}->paths(
+                $m_ctx, 'target', $ctx->get_id(), @paths,
+            );
+            $ctx->get_target_of()->{$ns}
+                = $ctx->CTX_TARGET->new({dests => $dest_list_ref, ns => $ns});
+        }
+    }
+}
+
+# Updates the project tree caches.
+sub _project_tree_caches_update {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    # If previous cache in .tar.gz, extract it
+    my $cache_tar_gz = $attrib_ref->{shared_util_of}{dest}->path(
+        $m_ctx, 'sys-cache', $ctx->get_id() . '.tar.gz',
+    );
+    if (-f $cache_tar_gz) {
+        my @command = (
+            qw{tar -x -z}, '-C', dirname($cache_tar_gz), '-f', $cache_tar_gz,
+        );
+        my %value_of = %{$UTIL->shell_simple(\@command)};
+        if ($value_of{'rc'} == 0) {
+            unlink($cache_tar_gz);
+        }
+    }
+    # Start the parallel task runner to do project tree caches update
+    my $timer = $UTIL->timer();
+    my $n_jobs = $m_ctx->get_option_of('jobs');
+    my $n_trees = scalar(
+        grep {!$_->get_cache()}
+        map {@{$_->get_trees()}}
+        values(%{$ctx->get_project_of()})
+    );
+    if ($n_trees == 0) {
+        return;
+    }
+    if ($n_jobs && $n_jobs > $n_trees) {
+        $n_jobs = $n_trees;
+    }
+    my $elapse_tasks = 0;
+    my @args = ($attrib_ref, $m_ctx, $ctx);
+    my $runner = $UTIL->task_runner(
+        sub {_project_tree_cache_update_by_export(@args, @_)},
+        $n_jobs,
+    );
+    my $n = eval {
+        $runner->main(
+            _project_tree_cache_update_get_func(@args),
+            _project_tree_cache_update_put_func(@args, \$elapse_tasks),
+        );
+    };
+    my $e = $@;
+    $runner->destroy();
+    if ($e) {
+        _finally($attrib_ref, $m_ctx, $ctx);
+        die($e);
+    }
+    $UTIL->event(
+        FCM::Context::Event->MAKE_EXTRACT_RUNNER_SUMMARY,
+        'tree-cache-export', $n, $timer->(), $elapse_tasks,
+    );
+}
+
+# Updates the source cache for a project tree by exporting it.
+sub _project_tree_cache_update_by_export {
+    my ($attrib_ref, $m_ctx, $ctx, $tree) = @_;
+    my $cache = $tree->get_cache();
+    # Exports the smallest common tree
+    my $root_ns;
+    SOURCE:
+    for my $source (@{$tree->get_sources()}) {
+        if ($source->is_unchanged()) {
+            next SOURCE;
+        }
+        if (!defined($root_ns)) {
+            $root_ns = $source->get_ns_in_tree();
+            next SOURCE;
+        }
+        $root_ns = $UTIL->ns_common(
+            $root_ns, $source->get_ns_in_tree(),
+        );
+        if (!$root_ns) {
+            last SOURCE;
+        }
+    }
+    if (!defined($root_ns)) {
+        return;
+    }
+    my $cache_ns = $root_ns ? catfile($cache, $root_ns) : $cache;
+    my $locator_ns = $UTIL->loc_cat(
+        $tree->get_locator(), split($UTIL->ns_sep(), $root_ns),
+    );
+    eval{
+        mkpath(dirname($cache_ns));
+        $UTIL->loc_export($locator_ns, $cache_ns);
+    };
+    if (my $e = $@ || !-e $cache_ns && !-l $cache_ns) {
+        return $E->throw($E->DEST_CREATE, $cache_ns, $e);
+    }
+}
+
+# Generates an iterator for each tree requiring cache update.
+sub _project_tree_cache_update_get_func {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    my @trees = map {@{$_->get_trees()}} values(%{$ctx->get_project_of()});
+    sub {
+        while (my $tree = shift(@trees)) {
+            if (!$tree->get_cache()) {
+                if ($UTIL->loc_export_ok($tree->get_locator())) {
+                    my $cache = $attrib_ref->{shared_util_of}{dest}->path(
+                        $m_ctx,
+                        'sys-cache',
+                        $ctx->get_id(),
+                        $tree->get_ns(),
+                        $tree->get_key(),
+                    );
+                    $tree->set_cache($cache);
+                    rmtree($cache);
+                    mkpath(dirname($cache));
+                    my $id = $tree->get_ns() . '/' . $tree->get_key();
+                    return FCM::Context::Task->new({ctx => $tree, id  => $id});
+                }
+                else {
+                    $tree->set_cache($tree->get_locator()->get_value());
+                    _project_tree_cache_update_sources(
+                        $attrib_ref, $m_ctx, $ctx, $tree,
+                    );
+                }
+            }
+        }
+        return;
+    };
+}
+
+# Generates a callback when a tree has a cache.
+sub _project_tree_cache_update_put_func {
+    my ($attrib_ref, $m_ctx, $ctx, $elapse_tasks_ref) = @_;
+    sub {
+        my ($task) = @_;
+        if ($task->get_state() eq $task->ST_FAILED) {
+            die($task->get_error());
+        }
+        my $ns = $task->get_ctx()->get_ns();
+        my $key = $task->get_ctx()->get_key();
+        my $tree = $ctx->get_project_of()->{$ns}->get_trees()->[$key];
+        _project_tree_cache_update_sources($attrib_ref, $m_ctx, $ctx, $tree);
+        ${$elapse_tasks_ref} += $task->get_elapse();
+    };
+}
+
+# Sets the caches of individual project tree sources.
+sub _project_tree_cache_update_sources {
+    my ($attrib_ref, $m_ctx, $ctx, $tree) = @_;
+    for my $source (@{$tree->get_sources()}) {
+        my $cache = catfile(
+            $tree->get_cache(),
+            split($UTIL->ns_sep(), $source->get_ns_in_tree()),
+        );
+        $source->set_cache($cache);
+    }
+}
+
+# Handles symbolic links.
+sub _symlink_handle {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    TARGET:
+    while (my ($ns, $target) = each(%{$ctx->get_target_of()})) {
+        if ($target->is_unchanged()) {
+            next TARGET;
+        }
+        my $source_hash_ref = $target->get_source_of();
+        # Remove sources that are symbolic links
+        while (my ($key, $source) = each(%{$source_hash_ref})) {
+            if ($source->get_cache() && -l $source->get_cache()) {
+                delete($source_hash_ref->{$key});
+                $UTIL->event(
+                    FCM::Context::Event->MAKE_EXTRACT_SYMLINK, $source,
+                );
+            }
+        }
+        # It is OK to have a target with no sources, but a target must have a
+        # base source if it has at least one diff source.
+        if (    keys(%{$source_hash_ref})
+            &&  !exists($source_hash_ref->{0})
+        ) {
+            $source_hash_ref->{0} = $ctx->CTX_SOURCE->new(
+                {key_of_tree => 0, status => $ctx->CTX_SOURCE->ST_MISSING},
+            );
+        }
+    }
+}
+
+# Updates the targets.
+sub _targets_update {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    my %basket_of = (status => {}, status_of_source => {});
+    eval {
+        while (my ($ns, $target) = each(%{$ctx->get_target_of()})) {
+            if ($target->get_status() eq $target->ST_UNKNOWN) {
+                my %source_of = %{$target->get_source_of()};
+                my $handler
+                    = keys(%source_of) ? \&_target_update
+                    :                    \&_target_delete
+                    ;
+                $handler->($attrib_ref, $m_ctx, $ctx, $target);
+                my $base = delete($source_of{0});
+                my @diffs = grep {!$_->is_unchanged()} values(%source_of);
+                $target->set_status_of_source(
+                      !keys(%{$target->get_source_of()}) ? $target->ST_UNKNOWN
+                    : $base->is_missing()                ? $target->ST_ADDED
+                    : (grep {$_->is_missing()} @diffs)   ? $target->ST_DELETED
+                    : scalar(@diffs) > 1                 ? $target->ST_MERGED
+                    : scalar(@diffs)                     ? $target->ST_MODIFIED
+                    :                                      $target->ST_UNCHANGED
+                );
+                $UTIL->event(
+                    FCM::Context::Event->MAKE_EXTRACT_TARGET, $target,
+                );
+            }
+            $basket_of{status}{$target->get_status()}++;
+            $basket_of{status_of_source}{$target->get_status_of_source()}++;
+        }
+    };
+    if (my $e = $@) {
+        _finally($attrib_ref, $m_ctx, $ctx);
+        die($e);
+    }
+    $UTIL->event(
+        FCM::Context::Event->MAKE_EXTRACT_TARGET_SUMMARY, \%basket_of,
+    );
+    _finally($attrib_ref, $m_ctx, $ctx);
+}
+
+# Updates a deleted target.
+sub _target_delete {
+    my ($attrib_ref, $m_ctx, $ctx, $target) = @_;
+    my ($dest, @inherited_dests) = @{$target->get_dests()};
+    if (-f $dest) {
+        unlink($dest) || return $E->throw($E->DEST_CLEAN, $dest, $!);
+        $target->set_status($target->ST_DELETED);
+    }
+    for my $inherited_dest (@inherited_dests) {
+        if (-f $inherited_dest) {
+            $target->set_status($target->ST_O_DELETED);
+            return;
+        }
+    }
+}
+
+# Updates a normal target.
+sub _target_update {
+    my ($attrib_ref, $m_ctx, $ctx, $target) = @_;
+    my %source_of = %{$target->get_source_of()};
+    my $source_of_base = delete($source_of{0});
+    # Either missing source in a diff-tree
+    # Or     missing source in base-tree and no diff-trees
+    if (    (grep {$_->is_missing()} values(%source_of))
+        ||  $source_of_base->is_missing() && !keys(%source_of)
+    ) {
+        return _target_delete($attrib_ref, $m_ctx, $ctx, $target);
+    }
+    my $path = _target_update_source($attrib_ref, $m_ctx, $ctx, $target);
+    # Note: $path may be a File::Temp object.
+    my ($is_diff, $is_diff_in_perms, $is_in_prev, $rc) = (1, 1, undef, 1);
+    DEST:
+    for my $i (0 .. @{$target->get_dests()} - 1) {
+        my $dest = $target->get_dests()->[$i];
+        if (-f $dest) {
+            $is_in_prev = $i;
+            ($is_diff_in_perms, $is_diff) = _compare("$path", $dest);
+            last DEST;
+        }
+    }
+    if (!$is_diff && !$is_diff_in_perms) {
+        $target->set_path($target->get_dests()->[$is_in_prev]);
+        $target->set_status($target->ST_UNCHANGED);
+        return; # up to date
+    }
+    my $dest = $target->get_dests()->[0];
+    if ($is_diff) {
+        my $dest_dir = dirname($dest);
+        if (!-d $dest_dir) {
+            eval {mkpath($dest_dir)};
+            if (my $e = $@) {
+                return $E->throw($E->DEST_CREATE, $dest_dir, $e);
+            }
+        }
+        copy("$path", $dest)
+            || return $E->throw($E->COPY, ["$path", $dest], $!);
+    }
+    chmod((stat("$path"))[2] & oct(7777), $dest)
+        || return $E->throw($E->DEST_CREATE, $dest, $!);
+    $target->set_path($target->get_dests()->[0]);
+    $target->set_status(
+          $is_in_prev          ? $target->ST_O_ADDED
+        : defined($is_in_prev) ? $target->ST_MODIFIED
+        :                        $target->ST_ADDED
+    );
+}
+
+# Returns the source path that is to be used to update a target.
+sub _target_update_source {
+    my ($attrib_ref, $m_ctx, $ctx, $target) = @_;
+    my %source_of = %{$target->get_source_of()};
+    my $path_of_base = delete($source_of{0})->get_cache();
+    my @keys_and_paths;
+    while (my ($key, $source) = each(%source_of)) {
+        my $path = $source->get_cache();
+        if (!$path_of_base || _compare($path_of_base, $path)) {
+            if (!grep {!_compare($_->[1], $path)} @keys_and_paths) {
+                push(@keys_and_paths, [$key, $path]);
+            }
+        }
+        else {
+            $source->set_status($source->ST_UNCHANGED);
+        }
+    }
+    my @args = (
+        $m_ctx, $ctx, $target, $path_of_base,
+        (sort {$a->[0] <=> $b->[0]} @keys_and_paths),
+    );
+    return (
+          @keys_and_paths == 0 ? $path_of_base
+        : @keys_and_paths == 1 ? $keys_and_paths[0][1]
+        :                        _target_update_source_merge($attrib_ref, @args)
+    );
+}
+
+# Merges changes in contents of paths in @keys_and_paths against content in
+# $path_of_base.
+sub _target_update_source_merge {
+    my ($attrib_ref, $m_ctx, $ctx, $target, $path_of_base, @keys_and_paths) = @_;
+    if (!$path_of_base) {
+        $path_of_base = File::Temp->new();
+        if (!defined($path_of_base) || !close($path_of_base)) {
+            return $E->throw($E->DEST_CREATE, tmpdir(), $!);
+        }
+    }
+    my ($key_of_mine, $path_of_mine) = @{shift(@keys_and_paths)};
+    my @keys_done = ($key_of_mine);
+    while (my $key_and_path = shift(@keys_and_paths)) {
+        my ($key, $path) = @{$key_and_path};
+        my @command = (
+            (map {_props($attrib_ref, $_, $ctx)} qw{diff3 diff3.flags}),
+            "$path_of_mine", "$path_of_base", $path,
+        );
+        my %value_of = %{$UTIL->shell_simple(\@command)};
+        if ($value_of{rc} && $value_of{rc} == 1) {
+            # Write conflict output to .fcm-make/extract/conflict/$NS
+            my $file = $attrib_ref->{shared_util_of}{dest}->path(
+                $m_ctx, 'sys', $ctx->get_id(), 'merge',
+                $target->get_ns() . '.diff',
+            );
+            $UTIL->file_save($file, $value_of{o});
+            return $E->throw($E->EXTRACT_MERGE, {
+                'target'    => $target,
+                'output'    => $file,
+                'keys_done' => \@keys_done,
+                'key'       => $key,
+                'keys_left' => [map {$_->[0]} @keys_and_paths],
+            });
+        }
+        elsif ($value_of{rc}) {
+            return $E->throw(
+                $E->SHELL, {command_list => \@command, %value_of}, $value_of{e},
+            );
+        }
+        my $perm = (stat("$path_of_mine"))[2] & 07777 | (stat($path))[2] & 07777;
+        for my $action (
+            sub {$path_of_mine = File::Temp->new()},
+            sub {print({$path_of_mine} $value_of{o})},
+            sub {close($path_of_mine)},
+            sub {chmod($perm, "$path_of_mine")},
+        ) {
+            $action->() || return $E->throw($E->DEST_CREATE, "$path_of_mine", $!);
+        }
+        push(@keys_done, $key);
+    }
+    return $path_of_mine;
+}
+
+# Perform final actions.
+# Archive cache directory if necessary.
+sub _finally {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    if (!$m_ctx->get_option_of('archive')) {
+        return;
+    }
+    my $cache = $attrib_ref->{shared_util_of}{dest}->path(
+        $m_ctx, 'sys-cache', $ctx->get_id(),
+    );
+    if (-d $cache) {
+        my @command = (
+            qw{tar -c -z}, '-C', dirname($cache), '-f', $cache . '.tar.gz',
+            $ctx->get_id(),
+        );
+        my %value_of = %{$UTIL->shell_simple(\@command)};
+        if ($value_of{'rc'} == 0) {
+            rmtree($cache);
+        }
+    }
+}
+
+# In scalar context, returns true if the contents or permissions of 2 paths
+# differ. In array context, returns ($is_diff_in_perms, $is_diff_in_content).
+sub _compare {
+    my ($path1, $path2) = @_;
+    my $is_diff_in_perms = (stat($path1))[2] != (stat($path2))[2];
+    wantarray()
+        ? ($is_diff_in_perms, compare($path1, $path2))
+        : ($is_diff_in_perms || compare($path1, $path2))
+    ;
+}
+
+# Returns true if two sources are the same or if their latest modified revisions
+# are the same.
+sub _source_eq {
+    my ($source1, $source2) = @_;
+    my ($locator1, $locator2) = map {$_->get_locator()} ($source1, $source2);
+    # Compares their value + mtime or their last modified revision
+            $locator1->get_value() eq $locator2->get_value()
+        &&  defined($locator1->get_last_mod_time())
+        &&  defined($locator2->get_last_mod_time())
+        &&  $locator1->get_last_mod_time() eq $locator2->get_last_mod_time()
+    ||      defined($locator1->get_last_mod_rev())
+        &&  defined($locator2->get_last_mod_rev())
+        &&  $locator1->get_last_mod_rev() eq $locator2->get_last_mod_rev()
+    ;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Extract
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Extract;
+    my $extract = FCM::System::Make::Extract->new(\%attrib);
+    $extract->($m_ctx, $ctx);
+
+=head1 DESCRIPTION
+
+Implements the extract sub-system. An instance of this class is expected to be
+initialised and called by L<FCM::System::Make|FCM::System::Make>.
+
+=head1 METHODS
+
+See L<FCM::System::Make|FCM::System::Make> for detail.
+
+=head1 ATTRIBUTES
+
+The $class->new(\%attrib) method of this class supports the following
+attributes:
+
+=over 4
+
+=item config_parser_of
+
+A HASH to map the labels in a configuration file to their parsers. (default =
+%FCM::System::Make::Extract::CONFIG_PARSER_OF)
+
+=item prop_of
+
+A HASH to map the names of the properties to their settings. Each setting
+is a 2-element ARRAY reference, where element [0] is the default setting
+and element [1] is a flag to indicate whether the property accepts a name-space
+or not. (default = %FCM::System::Make::Extract::PROP_OF)
+
+=item shared_util_of
+
+See L<FCM::System::Make|FCM::System::Make> for detail.
+
+=item util
+
+See L<FCM::System::Make|FCM::System::Make> for detail.
+
+=back
+
+=head1 TODO
+
+Handle alternate method of merge (e.g. Algorithm::Merge).
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Mirror.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Mirror.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Mirror.pm	(revision 5095)
@@ -0,0 +1,439 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Mirror;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::ConfigEntry;
+use FCM::Context::Event;
+use FCM::Context::Make;
+use FCM::Context::Make::Mirror;
+use FCM::Context::Make::Share::Property;
+use FCM::System::Make::Share::Subsystem;
+use File::Basename qw{dirname};
+use File::Path qw{mkpath};
+use File::Spec::Functions qw{abs2rel file_name_is_absolute rel2abs};
+use POSIX qw{strftime};
+use Storable qw{dclone};
+use Sys::Hostname qw{hostname};
+use Text::ParseWords qw{shellwords};
+
+# Alias
+my $E = 'FCM::System::Exception';
+
+# Configuration parser label to action map
+our %CONFIG_PARSER_OF = (
+    'target' => \&_config_parse_target,
+);
+
+# Default properties
+our %PROP_OF = (
+    'config-file.name'  => [q{}],
+    'config-file.steps' => [q{}],
+    'no-config-file'    => [q{}],
+);
+
+# Properties from FCM::Util
+our @UTIL_PROP_KEYS = qw{ssh ssh.flags rsync rsync.flags};
+
+# Creates the class.
+__PACKAGE__->class(
+    {   config_parser_of => {isa => '%', default => {%CONFIG_PARSER_OF}},
+        prop_of          => {isa => '%', default => {%PROP_OF}},
+        shared_util_of   => '%',
+        util             => '&',
+    },
+    {   init => \&_init,
+        action_of => {
+            config_parse              => \&_config_parse,
+            config_parse_class_prop   => \&_config_parse_class_prop,
+            config_parse_inherit_hook => \&_config_parse_inherit_hook,
+            config_unparse            => \&_config_unparse,
+            config_unparse_class_prop => \&_config_unparse_class_prop,
+            ctx                       => \&_ctx,
+            main                      => \&_main,
+        },
+    },
+);
+
+# Initialises the helpers of the class.
+sub _init {
+    my ($attrib_ref) = @_;
+    for my $util_prop_key (@UTIL_PROP_KEYS) {
+        my $prop = $attrib_ref->{util}->external_cfg_get($util_prop_key);
+        $attrib_ref->{prop_of}{$util_prop_key} = [$prop];
+    }
+}
+
+# Reads the mirror.target declaration from a config entry.
+sub _config_parse_target {
+    my ($attrib_ref, $ctx, $entry) = @_;
+    my $value = $entry->get_value();
+    # Note: it is easier to parse the value in reverse because a target may look
+    # like "path", "machine:path" or "logname@machine:path"
+    my ($path, $auth) = reverse(split(':', $value, 2));
+    my ($machine, $logname) = $auth ? reverse(split('@', $auth, 2)) : ();
+    if (!$path || ($logname && !$machine)) {
+        return $E->throw($E->CONFIG_VALUE, $entry);
+    }
+    $ctx->set_target_logname($logname);
+    $ctx->set_target_machine($machine);
+    $ctx->set_target_path($path);
+}
+
+# A hook command for the "inherit/use" declaration (extract).
+sub _config_parse_inherit_hook {
+    my ($attrib_ref, $ctx, $i_ctx) = @_;
+    $ctx->set_target_machine($i_ctx->get_target_machine());
+    _config_parse_inherit_hook_prop($attrib_ref, $ctx, $i_ctx);
+}
+
+# Turns a context into a list of configuration entries.
+sub _config_unparse {
+    my ($attrib_ref, $ctx) = @_;
+    (   (   $ctx->get_target_path()
+            ? FCM::Context::ConfigEntry->new({
+                label => $ctx->get_id() . q{.} . 'target',
+                value => (_target_and_authority($ctx))[0],
+            })
+            : ()
+        ),
+        _config_unparse_prop($attrib_ref, $ctx),
+    );
+}
+
+# Returns a new context.
+sub _ctx {
+    my ($attrib_ref, $id_of_class, $id) = @_;
+    FCM::Context::Make::Mirror->new({id => $id, id_of_class => $id_of_class});
+}
+
+# The main function.
+sub _main {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    if (!$ctx->get_target_path()) {
+        return $E->throw($E->MIRROR_NULL);
+    }
+    my $do_config_file = !_prop($attrib_ref, 'no-config-file', $ctx);
+    my @sources;
+    my @bad_step_list;
+    for my $step (@{$m_ctx->get_steps()}) {
+        my $ctx = $m_ctx->get_ctx_of($step);
+        if (    $ctx->get_status() eq $m_ctx->ST_OK
+            &&  $ctx->can('get_dest')
+            &&  -e $ctx->get_dest()
+        ) {
+            if ($do_config_file && !$ctx->can('MIRROR')) {
+                push(@bad_step_list, $step);
+            }
+            else {
+                push(@sources, $ctx->get_dest());
+            }
+        }
+    }
+    if (@bad_step_list) {
+        return $E->throw($E->MIRROR_SOURCE, \@bad_step_list);
+    }
+    for my $action (
+        \&_mirror_mkdir,
+        (@sources        ? \&_mirror             : ()),
+        ($do_config_file ? \&_mirror_config_file : ()),
+        \&_mirror_orig_config_file,
+    ) {
+        $action->($attrib_ref, $m_ctx, $ctx, \@sources);
+    }
+}
+
+# Creates a configuration file at the destination.
+sub _mirror_config_file {
+    my ($attrib_ref, $m_ctx, $ctx, $sources_ref) = @_;
+    my ($target) = _target_and_authority($ctx);
+    my $mirror_m_ctx = FCM::Context::Make->new({dest => '$HERE'});
+    $mirror_m_ctx->set_name(_prop($attrib_ref, 'config-file.name', $ctx));
+    my %no_inherit_from;
+    if (@{$m_ctx->get_inherit_ctx_list()}) {
+        # Inherited destinations
+        for my $i_m_ctx (@{$m_ctx->get_inherit_ctx_list()}) {
+            my $i_ctx = $i_m_ctx->get_ctx_of($ctx->get_id());
+            if (defined($i_ctx)) {
+                push(
+                    @{$mirror_m_ctx->get_inherit_ctx_list()},
+                    FCM::Context::Make->new({dest => $i_ctx->get_target_path()}),
+                );
+            }
+        }
+        # Completed steps, from which the targets can be sourced
+        DONE_STEP:
+        for my $step (@{$m_ctx->get_steps()}) {
+            my $step_ctx = $m_ctx->get_ctx_of($step);
+            if (    !defined($step_ctx)
+                ||  $step_ctx->get_status() ne $m_ctx->ST_OK
+                ||  !$step_ctx->can('get_target_of')
+            ) {
+                next DONE_STEP;
+            }
+            while (my ($key, $target) = each(%{$step_ctx->get_target_of()})) {
+                if (!$target->is_ok()) {
+                    $no_inherit_from{$target->get_ns()} = 1;
+                }
+            }
+        }
+    }
+    # Steps to include in the configuration file
+    for my $step (_props($attrib_ref, 'config-file.steps', $ctx)) {
+        my $step_ctx = $m_ctx->get_ctx_of($step);
+        if (    !defined($step_ctx)
+            ||  $step_ctx->get_status() ne $m_ctx->ST_UNKNOWN
+        ) {
+            return $E->throw(
+                $E->MAKE_PROP_VALUE,
+                [[$ctx->get_id(), 'config-file.steps', q{}, $step]],
+            );
+        }
+        push(@{$mirror_m_ctx->get_steps()}, $step);
+        $mirror_m_ctx->get_ctx_of()->{$step} = dclone($step_ctx);
+        my $mirror_ctx = $mirror_m_ctx->get_ctx_of()->{$step};
+        if ($mirror_ctx->can('get_input_source_of')) {
+            %{$mirror_ctx->get_input_source_of()} = (
+                q{} => [map {abs2rel($_, $m_ctx->get_dest())} @{$sources_ref}],
+            );
+        }
+        if (keys(%no_inherit_from)) {
+            my @no_inherit_from_ns_list = sort keys(%no_inherit_from);
+            push(
+                @no_inherit_from_ns_list,
+                _props($attrib_ref, 'no-inherit-source', $mirror_ctx),
+            );
+            my $prop_value = FCM::Context::Make::Share::Property::Value->new({
+                value => join(
+                    q{ },
+                    map {s{['"\s]}{\\$1}gmsx; $_} @no_inherit_from_ns_list,
+                ),
+            });
+            my $prop = FCM::Context::Make::Share::Property->new({
+                id => 'no-inherit-source',
+                ctx_of => {q{} => $prop_value},
+            });
+            $mirror_ctx->get_prop_of()->{'no-inherit-source'} = $prop;
+        }
+    }
+    # Saves the configuration file
+    my @lines = map {$_ . "\n"}
+        $attrib_ref->{shared_util_of}{config}->unparse($mirror_m_ctx);
+    my $DEST_UTIL = $attrib_ref->{shared_util_of}{dest};
+    my $path = $DEST_UTIL->path(
+        {   'dest' => $ctx->get_dest(),
+            'name' => _prop($attrib_ref, 'config-file.name', $ctx),
+        },
+        'config',
+    );
+    $attrib_ref->{util}->file_save($path, \@lines);
+    _mirror(
+        $attrib_ref, $m_ctx, $ctx,
+        [$path], $DEST_UTIL->path(
+            {   'dest' => $target,
+                'name' => _prop($attrib_ref, 'config-file.name', $ctx),
+            },
+            'config',
+        ),
+    );
+}
+
+# Creates mirror destination.
+sub _mirror_mkdir {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    my ($target, $authority, $path) = _target_and_authority($ctx);
+    eval {
+        if ($authority) {
+            my @ssh
+                = (_shell_cmd_list($attrib_ref, 'ssh', $ctx), $authority);
+            if (!file_name_is_absolute($path)) {
+                my $value_hash_ref = _shell($attrib_ref, [@ssh, 'pwd']);
+                my $path_root = $value_hash_ref->{'o'};
+                chomp($path_root);
+                $ctx->set_target_path(rel2abs($path, $path_root));
+            }
+            _shell($attrib_ref, [@ssh, 'mkdir', '-p', $path]);
+        }
+        else {
+            if (!file_name_is_absolute($path)) {
+                $ctx->set_target_path(rel2abs($path));
+            }
+            if (!-d $path) {
+                mkpath($path);
+            }
+        }
+    };
+    if (my $e = $@) {
+        return $E->throw($E->MIRROR_TARGET, $target, $e);
+    }
+    1;
+}
+
+# Mirror original configuration (by unparsing $m_ctx).
+sub _mirror_orig_config_file {
+    my ($attrib_ref, $m_ctx, $ctx) = @_;
+    my @lines = (
+        "# Original fcm make configuration.\n",
+        sprintf("# Generated by %s@%s at %s.\n",
+            scalar(getpwuid($<)),
+            hostname(),
+            strftime("%Y-%m-%dT%H:%M:%S%z", localtime()),
+        ),
+        map {$_ . "\n"} $attrib_ref->{shared_util_of}{config}->unparse($m_ctx),
+    );
+    my $DEST_UTIL = $attrib_ref->{shared_util_of}{dest};
+    my $path = $DEST_UTIL->path(
+        {   'dest' => $ctx->get_dest(),
+            'name' => _prop($attrib_ref, 'config-file.name', $ctx),
+        },
+        'config-orig',
+    );
+    $attrib_ref->{util}->file_save($path, \@lines);
+    my ($target) = _target_and_authority($ctx);
+    _mirror(
+        $attrib_ref, $m_ctx, $ctx,
+        [$path],
+        $DEST_UTIL->path(
+            {   'dest' => $target,
+                'name' => _prop($attrib_ref, 'config-file.name', $ctx),
+            },
+            'config-orig',
+        ),
+    );
+}
+
+# Mirrors.
+sub _mirror {
+    my ($attrib_ref, $m_ctx, $ctx, $sources_ref, $target) = @_;
+    $target ||= (_target_and_authority($ctx))[0];
+    $attrib_ref->{util}->event(
+        FCM::Context::Event->MAKE_MIRROR, $target, @{$sources_ref},
+    );
+    eval {
+        _shell(
+            $attrib_ref,
+            [   _shell_cmd_list($attrib_ref, 'rsync', $ctx),
+                @{$sources_ref},
+                $target,
+            ],
+        );
+    };
+    if (my $e = $@) {
+        return $E->throw($E->MIRROR, [$target, @{$sources_ref}], $e);
+    }
+    1;
+}
+
+# Invokes a known shell command.
+sub _shell {
+    my ($attrib_ref, $command_list_ref) = @_;
+    my $value_hash_ref = $attrib_ref->{util}->shell_simple($command_list_ref);
+    if ($value_hash_ref->{rc}) {
+        return $E->throw(
+            $E->SHELL,
+            {command_list => $command_list_ref, %{$value_hash_ref}},
+            $value_hash_ref->{e},
+        );
+    }
+    $value_hash_ref;
+}
+
+# Returns a shell command and its flags from a named property.
+sub _shell_cmd_list {
+    my ($attrib_ref, $id, $ctx) = @_;
+    map {_props($attrib_ref, $_, $ctx)} ($id, $id . '.flags');
+}
+
+# Returns the authority and the target.
+sub _target_and_authority {
+    my ($ctx) = @_;
+    my $logname = $ctx->get_target_logname();
+    my $machine = $ctx->get_target_machine();
+    my $path    = $ctx->get_target_path();
+    my $authority
+        = $logname && $machine ? $logname . '@' . $machine
+        : $logname             ? $logname . '@' . 'localhost'
+        : $machine             ?                  $machine
+        :                        undef
+        ;
+    my $target = $authority ? $authority . ':' . $path : $path;
+    ($target, $authority, $path);
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Mirror
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Mirror;
+    my $subsystem = FCM::System::Make::Mirror->new(\%attrib);
+    $subsystem->main($m_ctx, $ctx);
+
+=head1 DESCRIPTION
+
+Implements the mirror sub-system. An instance of this class is expected to be
+initialised and called by L<FCM::System::Make|FCM::System::Make>.
+
+=head1 METHODS
+
+See L<FCM::System::Make|FCM::System::Make> for detail.
+
+=head1 ATTRIBUTES
+
+The $class->new(\%attrib) method of this class supports the following
+attributes:
+
+=over 4
+
+=item config_parser_of
+
+A HASH to map the labels in a configuration file to their parsers. (default =
+%FCM::System::Make::Mirror::CONFIG_PARSER_OF)
+
+=item prop_of
+
+A HASH to map the names of the properties to their settings. Each setting
+is a 2-element ARRAY reference, where element [0] is the default setting
+and element [1] is a flag to indicate whether the property accepts a name-space
+or not. (default = %FCM::System::Make::Mirror::PROP_OF)
+
+=item shared_util_of
+
+See L<FCM::System::Make|FCM::System::Make> for detail.
+
+=item util
+
+See L<FCM::System::Make|FCM::System::Make> for detail.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Preprocess.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Preprocess.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Preprocess.pm	(revision 5095)
@@ -0,0 +1,91 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Preprocess;
+use base qw{FCM::System::Make::Build};
+
+use FCM::System::Make::Build::FileType::CPP;
+use FCM::System::Make::Build::FileType::FPP;
+use FCM::System::Make::Build::FileType::H  ;
+
+# Default target selection
+our %TARGET_SELECT_BY = (
+    'category' => {},
+    'key'      => {},
+    'task'     => {q{} => {'process' => 1}},
+);
+
+# Classes for working with typed source files
+our @FILE_TYPE_UTILS = (
+    'FCM::System::Make::Build::FileType::FPP',
+    'FCM::System::Make::Build::FileType::CPP',
+    'FCM::System::Make::Build::FileType::HPP',
+);
+
+# Default properties
+my %PROP_OF = (
+    'ignore-missing-dep-ns'      => [q{}, undef],
+    'no-step-source'             => [q{}, undef],
+    'no-inherit-source'          => [q{}, undef],
+    'no-inherit-target-category' => [q{}, undef],
+);
+
+# Returns an instance of FCM::System::Make::Build;
+sub new {
+    my ($class, $attrib_ref) = @_;
+    bless(
+        FCM::System::Make::Build->new({
+            target_select_by => {%TARGET_SELECT_BY},
+            file_type_utils  => [@FILE_TYPE_UTILS],
+            prop_of          => {%PROP_OF},
+            %{$attrib_ref},
+        }),
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Preprocess
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Preprocess;
+    my $system = FCM::System::Make::Preprocess->new(\%attrib);
+    $system->main(\%option_of, @args);
+
+=head1 DESCRIPTION
+
+A wrapper of L<FCM::System::Make::Build|FCM::System::Make::Build> with
+configuration to trigger the preprocessing of Fortran and C source files.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
+
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Share/Config.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Share/Config.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Share/Config.pm	(revision 5095)
@@ -0,0 +1,431 @@
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+use strict;
+use warnings;
+#-------------------------------------------------------------------------------
+
+package FCM::System::Make::Share::Config;
+use base qw{FCM::Class::CODE};
+
+use Cwd qw{cwd};
+use FCM::Context::ConfigEntry;
+use FCM::Context::Locator;
+use FCM::System::Exception;
+use File::Spec::Functions qw{file_name_is_absolute};
+use File::Temp;
+use Text::ParseWords qw{shellwords};
+use Scalar::Util qw{blessed};
+
+# Alias to class name
+my $E = 'FCM::System::Exception';
+
+# Configuration parser label to action map
+my %CONFIG_PARSER_OF = (
+    'description'     => \&_parse_description,
+    'dest'            => \&_parse_dest,
+    'name'            => \&_parse_name,
+    'require-version' => \&_parse_require_version,
+    'step.class'      => \&_parse_step_class,
+    'steps'           => \&_parse_steps,
+    'use'             => \&_parse_use,
+);
+
+__PACKAGE__->class(
+    {shared_util_of => '%', subsystem_of => '%', util => '&'},
+    {action_of => {parse => \&_parse, unparse => \&_unparse}},
+);
+
+# Get configuration file entries from an iterator, and use the entries to
+# populate the context of the current make.
+sub _parse {
+    my ($attrib_ref, $entry_callback_ref, $m_ctx, @args) = @_;
+    my $DEST_UTIL = $attrib_ref->{shared_util_of}{dest};
+    my $dir = $m_ctx->get_option_of('directory')
+        ? $m_ctx->get_option_of('directory') : cwd();
+    my $dir_locator = FCM::Context::Locator->new($dir);
+    my @config_file_paths = $m_ctx->get_option_of('config-file-path')
+        ? @{$m_ctx->get_option_of('config-file-path')} : ();
+    my @config_file_path_locators
+        = map {FCM::Context::Locator->new($_)} @config_file_paths;
+    my @config_file_names = $m_ctx->get_option_of('config-file')
+        ? @{$m_ctx->get_option_of('config-file')} : (undef);
+    my @config_reader_refs;
+    for my $config_file_name (@config_file_names) {
+        my $is_specified_name = 1;
+        if (!defined($config_file_name)) {
+            $config_file_name = $DEST_UTIL->path(
+                {'name' => $m_ctx->get_name()}, 'config');
+            $is_specified_name = 0;
+        }
+        if (    $attrib_ref->{util}->uri_match($config_file_name)
+            ||  file_name_is_absolute($config_file_name)
+        ) {
+            push(@config_reader_refs, _get_config_reader(
+                $attrib_ref, $config_file_name, [@config_file_path_locators],
+            ));
+        }
+        else {  # $config_file_name is relative
+            my $config_reader_ref;
+            HEAD:
+            for my $head_locator ($dir_locator, @config_file_path_locators) {
+                my $locator = $attrib_ref->{util}->loc_cat(
+                    $head_locator, $config_file_name,
+                );
+                if ($attrib_ref->{util}->loc_exists($locator)) {
+                    $config_reader_ref = _get_config_reader(
+                        $attrib_ref, $locator, [@config_file_path_locators],
+                    );
+                    last HEAD;
+                }
+            }
+            if (defined($config_reader_ref)) {
+                push(@config_reader_refs, $config_reader_ref);
+            }
+            elsif ($is_specified_name) {
+                return $E->throw($E->MAKE_CFG_FILE, $config_file_name);
+            }
+        }
+    }
+    if (!@config_reader_refs) {
+        my $config_file_name = $DEST_UTIL->path(
+            {'dest' => $dir_locator->get_value(), 'name' => $m_ctx->get_name()},
+            'config',
+        );
+        if (-f $config_file_name) {
+            push(@config_reader_refs, _get_config_reader(
+                $attrib_ref, $config_file_name, [@config_file_path_locators],
+            ));
+        }
+    }
+    my $args_config_handle;
+    if (@args) {
+        $args_config_handle = File::Temp->new(
+            SUFFIX   => '-fcm-make-args.cfg',
+            TEMPLATE => 'XXXXXX',
+            TMPDIR   => 1,
+        );
+        for my $arg (@args) {
+            print($args_config_handle "$arg\n");
+        }
+        $args_config_handle->seek(0, 0);
+        push(@config_reader_refs, _get_config_reader(
+            $attrib_ref,
+            $args_config_handle->filename(),
+            [@config_file_path_locators],
+        ));
+    }
+    if (!@config_reader_refs) {
+        return $E->throw($E->MAKE_CFG);
+    }
+    my $entry_iter_ref = sub {
+        while (@config_reader_refs) {
+            my $entry = $config_reader_refs[0]->();
+            if (defined($entry)) {
+                return $entry;
+            }
+            shift(@config_reader_refs);
+        }
+        return undef;
+    };
+    my @unknown_entries;
+    while (defined(my $entry = $entry_iter_ref->())) {
+        if (defined($entry_callback_ref)) {
+            $entry_callback_ref->($entry);
+        }
+        if (exists($CONFIG_PARSER_OF{$entry->get_label()})) {
+            $CONFIG_PARSER_OF{$entry->get_label()}->(
+                $attrib_ref, $m_ctx, $entry,
+            );
+        }
+        else {
+            my ($id, $label) = split(qr{\.}msx, $entry->get_label(), 2);
+            if (    $label
+                &&  $label eq 'prop'
+                &&  exists($entry->get_modifier_of()->{'class'})
+                &&  exists($attrib_ref->{subsystem_of}{$id})
+            ) {
+                my $subsystem = $attrib_ref->{subsystem_of}{$id};
+                if (!$subsystem->config_parse_class_prop($entry, $label)) {
+                    push(@unknown_entries, $entry);
+                }
+            }
+            else {
+                my $ctx = $m_ctx->get_ctx_of($id);
+                if (    !defined($ctx)
+                    &&  exists($attrib_ref->{subsystem_of}{$id})
+                ) {
+                    $ctx = $attrib_ref->{subsystem_of}{$id}->ctx($id, $id);
+                    $m_ctx->get_ctx_of()->{$id} = $ctx;
+                }
+                my $rc;
+                if (defined($ctx)) {
+                    my $id_of_class = $ctx->get_id_of_class();
+                    my $subsystem = $attrib_ref->{subsystem_of}{$id_of_class};
+                    $rc = $subsystem->config_parse($ctx, $entry, $label);
+                }
+                if (!$rc) {
+                    push(@unknown_entries, $entry);
+                }
+            }
+        }
+    }
+    if (defined($args_config_handle)) {
+        $args_config_handle->close();
+    }
+    if (@unknown_entries) {
+        return $E->throw($E->CONFIG_UNKNOWN, \@unknown_entries);
+    }
+    $m_ctx;
+}
+
+# Returns a config reader.
+sub _get_config_reader {
+    my ($attrib_ref, $locator, $config_file_path_locators_ref) = @_;
+    if (!blessed($locator)) {
+        $locator = FCM::Context::Locator->new($locator);
+    }
+    $attrib_ref->{util}->config_reader(
+        $locator,
+        {   event_level   => $attrib_ref->{util}->util_of_report()->LOW,
+            include_paths => $config_file_path_locators_ref,
+        },
+    );
+}
+
+# Reads the "description" declaration from a config entry.
+sub _parse_description {
+    my ($attrib_ref, $m_ctx, $entry) = @_;
+    $m_ctx->set_description($entry->get_value());
+}
+
+# Reads the "dest" declaration from a config entry.
+sub _parse_dest {
+    my ($attrib_ref, $m_ctx, $entry) = @_;
+    $m_ctx->set_dest($entry->get_value());
+}
+
+# Reads the "name" declaration from a config entry.
+sub _parse_name {
+    my ($attrib_ref, $m_ctx, $entry) = @_;
+    $m_ctx->set_name($entry->get_value());
+}
+
+# Parse "require-version" declaration from a config entry.
+sub _parse_require_version {
+    my ($attrib_ref, $m_ctx, $entry) = @_;
+    my ($version) = shellwords($attrib_ref->{util}->version());
+    my ($min_version, $max_version) = shellwords($entry->get_value());
+    if (    $min_version gt $version
+        ||  defined($max_version) && $version gt $max_version
+    ) {
+        return $E->throw($E->CONFIG_VERSION, $entry, $version);
+    }
+}
+
+# Reads the step.class declaration from a config entry.
+sub _parse_step_class {
+    my ($attrib_ref, $m_ctx, $entry) = @_;
+    my $id_of_class = $entry->get_value();
+    if (!exists($attrib_ref->{subsystem_of}{$id_of_class})) {
+        return $E->throw($E->CONFIG_VALUE, $entry);
+    }
+    my $subsystem = $attrib_ref->{subsystem_of}{$id_of_class};
+    for my $id (@{$entry->get_ns_list()}) {
+        if (!defined($m_ctx->get_ctx_of($id))) {
+            $m_ctx->get_ctx_of()->{$id} = $subsystem->ctx($id_of_class, $id);
+        }
+    }
+}
+
+# Reads the steps declaration from a config entry.
+sub _parse_steps {
+    my ($attrib_ref, $m_ctx, $entry) = @_;
+    my @steps = $entry->get_values();
+    $m_ctx->set_steps(\@steps);
+    for my $id (@steps) {
+        if (!defined($m_ctx->get_ctx_of($id))) {
+            if (!exists($attrib_ref->{subsystem_of}{$id})) {
+                return $E->throw($E->CONFIG_VALUE, $entry);
+            }
+            my $subsystem = $attrib_ref->{subsystem_of}{$id};
+            $m_ctx->get_ctx_of()->{$id} = $subsystem->ctx($id, $id);
+        }
+    }
+}
+
+# Reads the use declaration.
+sub _parse_use {
+    my ($attrib_ref, $m_ctx, $entry) = @_;
+    my $DEST = $attrib_ref->{shared_util_of}{dest};
+    my $inherit_ctx_list_ref = $m_ctx->get_inherit_ctx_list();
+    for my $value ($entry->get_values()) {
+        $value = $attrib_ref->{util}->file_tilde_expand($value);
+        my $i_m_ctx = eval {$DEST->ctx_load($m_ctx, $value)};
+        if (my $e = $@) {
+            return $E->throw($E->CONFIG_VALUE, $entry, $e);
+        }
+        if (!defined($i_m_ctx) || $i_m_ctx->get_status() != $i_m_ctx->ST_OK) {
+            return $E->throw($E->CONFIG_INHERIT, $entry);
+        }
+        push(@{$m_ctx->get_inherit_ctx_list()}, $i_m_ctx);
+        while (my ($id, $i_ctx) = each(%{$i_m_ctx->get_ctx_of()})) {
+            my $id_of_class = $i_ctx->get_id_of_class();
+            if (exists($attrib_ref->{subsystem_of}{$id_of_class})) {
+                my $subsystem = $attrib_ref->{subsystem_of}{$id_of_class};
+                if (!defined($m_ctx->get_ctx_of($id))) {
+                    $m_ctx->get_ctx_of()->{$id}
+                        = $subsystem->ctx($id_of_class, $id);
+                }
+                if ($subsystem->can('config_parse_inherit_hook')) {
+                    $subsystem->config_parse_inherit_hook(
+                        $m_ctx->get_ctx_of($id), $i_ctx,
+                    );
+                }
+            }
+        }
+        if (!@{$m_ctx->get_steps()}) {
+            $m_ctx->set_steps([@{$i_m_ctx->get_steps()}]);
+        }
+    }
+}
+
+# Turns the context back into a config.
+sub _unparse {
+    my ($attrib_ref, $m_ctx) = @_;
+    my %subsystem_of = map {
+        my $id = $m_ctx->get_ctx_of()->{$_}->get_id_of_class();
+        ($id, $attrib_ref->{subsystem_of}->{$id});
+    } @{$m_ctx->get_steps()};
+    map {$_->as_string()} (
+        (   map {   FCM::Context::ConfigEntry->new({
+                        label   => 'step.class',
+                        ns_list => [$_->get_id()],
+                        value   => $_->get_id_of_class(),
+                    });
+                }
+            grep {$_->get_id() ne $_->get_id_of_class()}
+            values(%{$m_ctx->get_ctx_of()})
+        ),
+        (   map {   my ($action_ref, $label) = @{$_};
+                    my $value = $action_ref->($attrib_ref, $m_ctx);
+                    defined($value)
+                        ? FCM::Context::ConfigEntry->new(
+                            {label => $label, value => $value},
+                        )
+                        : ()
+                    ;
+                }
+            (   [sub {$m_ctx->get_name()}       , 'name'        ],
+                [\&_unparse_use                 , 'use'         ],
+                [\&_unparse_steps               , 'steps'       ],
+                [sub {$m_ctx->get_dest()}       , 'dest'        ],
+                [sub {$m_ctx->get_description()}, 'description' ],
+            ),
+        ),
+        (   map {   my $id = $_;
+                    $subsystem_of{$id}->config_unparse_class_prop($id);
+            }
+            sort keys(%subsystem_of)
+        ),
+        (   map {   my $ctx = $m_ctx->get_ctx_of()->{$_};
+                    my $id_of_class = $ctx->get_id_of_class();
+                    $subsystem_of{$id_of_class}->config_unparse($ctx);
+                }
+            @{$m_ctx->get_steps()}
+        ),
+    );
+}
+
+# Serializes a list of words.
+sub _unparse_join {
+    join(q{ }, map {s{(["'\s])}{\\$1}xms; $_} grep {defined()} @_);
+}
+
+# The value of "steps" declaration from the context.
+sub _unparse_steps {
+    my ($attrib_ref, $m_ctx) = @_;
+    if (!@{$m_ctx->get_steps()}) {
+        return;
+    }
+    _unparse_join(@{$m_ctx->get_steps()});
+}
+
+# The value of "use" declaration from the context.
+sub _unparse_use {
+    my ($attrib_ref, $m_ctx) = @_;
+    if (!@{$m_ctx->get_inherit_ctx_list()}) {
+        return;
+    }
+    my @i_ctx_list = @{$m_ctx->get_inherit_ctx_list()};
+    _unparse_join(map {$_->get_dest()} @i_ctx_list);
+}
+
+#-------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Share::Config
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Share::Config;
+    my $instance = FCM::System::Make::Share::Config->new(\%attrib);
+    my $ok = $instance->parse($m_ctx, $entry_iter_ref);
+    my @entries = $instance->unparse($m_ctx);
+
+=head1 DESCRIPTION
+
+A helper class for (un)parsing make config entries into the make context.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Returns a new instance. The allowed elements for %attrib are:
+
+=over 4
+
+=item {shared_util_of}{dest}
+
+A helper object for manipulating the destination in a make context. Expects an
+instance of L<FCM::System::Make::Share::Dest|FCM::System::Make::Share::Dest>.
+
+=back
+
+=item $instance->parse($m_ctx, $entry_iter_ref)
+
+Parses entries returned by the $entry_iter_ref iterator into the $m_ctx.
+Throws a variety of L<FCM::System::Exception|FCM::System::Exception> if some
+data in the configuration file is incorrectly set.
+
+=item $instance->unparse($m_ctx)
+
+Turns $m_ctx back into a list of configuration entries.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Share/Dest.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Share/Dest.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Share/Dest.pm	(revision 5095)
@@ -0,0 +1,503 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Share::Dest;
+use base qw{FCM::Class::CODE};
+
+use Cwd qw{cwd};
+use FCM::Context::Event;
+use FCM::System::Exception;
+use File::Basename qw{dirname};
+use File::Path qw{mkpath rmtree};
+use File::Spec::Functions qw{catfile rel2abs};
+use File::Temp;
+use IO::Uncompress::Gunzip qw{gunzip};
+use IO::Compress::Gzip qw{gzip};
+use Scalar::Util qw{blessed reftype};
+use Storable qw{fd_retrieve nstore_fd};
+use Sys::Hostname qw{hostname};
+
+# The relative paths for locating files in a destination
+our %PATH_OF = (
+    'config'                        => 'fcm-make%s.cfg',
+    'config-orig'                   => 'fcm-make%s.cfg.orig',
+    'sys'                           => '.fcm-make%s',
+    'sys-cache'                     => '.fcm-make%s/cache',
+    'sys-config-as-parsed'          => '.fcm-make%s/config-as-parsed.cfg',
+    'sys-config-as-parsed-symlink'  => 'fcm-make%s-as-parsed.cfg',
+    'sys-config-on-success'         => '.fcm-make%s/config-on-success.cfg',
+    'sys-config-on-success-symlink' => 'fcm-make%s-on-success.cfg',
+    'sys-ctx-uncompressed'          => '.fcm-make%s/ctx',
+    'sys-ctx'                       => '.fcm-make%s/ctx.gz',
+    'sys-log'                       => '.fcm-make%s/log',
+    'sys-log-symlink'               => 'fcm-make%s.log',
+    'sys-lock'                      => 'fcm-make%s.lock',
+    'sys-lock-info'                 => 'fcm-make%s.lock/info.txt',
+    'target'                        => '',
+);
+
+# Aliases to exception classes
+my $E = 'FCM::System::Exception';
+# List of actions
+my %ACTION_OF = (
+    ctx_load  => \&_ctx_load,
+    dest_done => \&_dest_done,
+    dest_init => \&_dest_init,
+    path      => \&_path,
+    paths     => \&_paths,
+    path_of   => sub {$_[0]->{'path_of'}{$_[1]}},
+    save      => \&_save,
+    tidy      => \&_tidy,
+);
+
+# Creates the class.
+__PACKAGE__->class(
+    {   path_of        => {isa => '%', default => {%PATH_OF}},
+        shared_util_of => '%',
+        subsystem_of   => '%',
+        util           => '&',
+    },
+    {action_of => \%ACTION_OF},
+);
+
+# Loads a storable context from a path.
+sub _ctx_load {
+    my ($attrib_ref, $m_ctx, $from) = @_;
+    my $path;
+    my $dest;
+    if ($from) {
+        NAME:
+        for my $name ($m_ctx->get_name(), undef) {
+            $path = _path(
+                $attrib_ref, {'dest' => $from, 'name' => $name}, 'sys-ctx');
+
+            if (-f $path) {
+                $dest = $from;
+                last NAME;
+            }
+        }
+    }
+    else {
+        $path = _path($attrib_ref, $m_ctx, 'sys-ctx');
+        $dest = $m_ctx->get_dest();
+    }
+    my $old_m_ctx = eval {
+        my $handle = File::Temp->new('TMPDIR' => 1);
+        # Open the file here to work around permission problems with file ACLs
+        open(my $path_handle, '<', $path) || die($!);
+        gunzip($path_handle, $handle) || die($!);
+        $handle->seek(0, 0);
+        fd_retrieve($handle);
+    };
+    if (my $e = $@) {
+        return $E->throw($E->CACHE_LOAD, $path, $e);
+    }
+    if (    !$old_m_ctx
+        ||  !$old_m_ctx->isa(blessed($m_ctx))
+        ||  (       defined($old_m_ctx->get_name())
+                &&  $old_m_ctx->get_name() ne $m_ctx->get_name()
+            )
+    ) {
+        return $E->throw($E->CACHE_TYPE, $path);
+    }
+    my $new_m_dest = rel2abs($dest);
+    if ($new_m_dest ne $old_m_ctx->get_dest()) {
+        my $old_m_dest = $old_m_ctx->get_dest();
+        $old_m_ctx->set_dest($new_m_dest);
+        $old_m_ctx->set_dest_lock(undef);
+        SUBSYSTEM:
+        while (my ($id, $old_ctx) = each(%{$old_m_ctx->get_ctx_of()})) {
+            my $id_of_class = $old_ctx->get_id_of_class();
+            if (exists($attrib_ref->{'subsystem_of'}{$id_of_class})) {
+                my $subsystem = $attrib_ref->{'subsystem_of'}{$id_of_class};
+                if (!$old_ctx->can('set_dest')) {
+                    next SUBSYSTEM;
+                }
+                my $old_dest = $old_ctx->get_dest();
+                $old_ctx->set_dest(_path(
+                    $attrib_ref,
+                    {'dest' => $new_m_dest, 'name' => $m_ctx->get_name()},
+                    'target',
+                    $old_ctx->get_id(),
+                ));
+                if ($subsystem->can('ctx_load_hook')) {
+                    $subsystem->ctx_load_hook(
+                        $old_m_ctx, $old_ctx, $old_m_dest, $old_dest);
+                }
+            }
+        }
+    }
+    return $old_m_ctx;
+}
+
+# Finalises the destination of a make context.
+sub _dest_done {
+    my ($attrib_ref, $m_ctx) = @_;
+    if (!$m_ctx->get_dest()) {
+        return;
+    }
+    my $dest = _path($attrib_ref, $m_ctx, 'sys-ctx-uncompressed');
+    my $dest_parent = dirname($dest);
+    my $dest_lock = $m_ctx->get_dest_lock();
+    $m_ctx->set_dest_lock(undef);
+    if (-d $dest_parent) {
+        eval {
+            my $handle = File::Temp->new('TMPDIR' => 1);
+            nstore_fd($m_ctx, $handle) || die($!);
+            $handle->seek(0, 0) || die($!);
+            gzip($handle, _path($attrib_ref, $m_ctx, 'sys-ctx')) || die($!);
+        };
+        if (my $e = $@) {
+            return $E->throw($E->DEST_CREATE, $dest, $e);
+        }
+    }
+    my %ctx_of = %{$m_ctx->get_ctx_of()};
+    for my $path (
+        _path($attrib_ref, $m_ctx, 'sys'),
+        (map {_path($attrib_ref, $m_ctx, 'target', $_)} keys(%ctx_of)),
+    ) {
+        _tidy($attrib_ref, $path);
+    }
+    if ($dest_lock) {
+        rmtree($dest_lock);
+    }
+}
+
+# Initialises the destination of a make context.
+sub _dest_init {
+    my ($attrib_ref, $m_ctx) = @_;
+    my %OPTION_OF = %{$m_ctx->get_option_of()};
+    # Select destination
+    my $dest
+        = $OPTION_OF{directory} ? $OPTION_OF{directory}
+        : $m_ctx->get_dest()    ? $m_ctx->get_dest()
+        :                         cwd()
+        ;
+    $m_ctx->set_dest(rel2abs($dest));
+    # Check lock
+    my $lock = _path($attrib_ref, $m_ctx, 'sys-lock');
+    if (!$OPTION_OF{'ignore-lock'} && -e $lock) {
+        return $E->throw($E->DEST_LOCKED, $lock);
+    }
+    # Creates the lock (and the destination), if necessary
+    if (!-e $lock) {
+        eval {mkpath($lock)};
+        if (my $e = $@) {
+            return $E->throw($E->DEST_CREATE, $lock, $e);
+        }
+        my $lock_info = scalar(getpwuid($<)) . '@' . hostname() .  ':' . $$;
+        _save($attrib_ref, $lock_info, $m_ctx, 'sys-lock-info');
+    }
+    $m_ctx->set_dest_lock($lock);
+    # Cleans items created by previous make, if necessary
+    for my $path (
+        _path($attrib_ref, $m_ctx, 'sys-config-as-parsed-symlink'),
+        _path($attrib_ref, $m_ctx, 'sys-config-on-success-symlink'),
+        _path($attrib_ref, $m_ctx, 'sys-config-on-success'),
+        _path($attrib_ref, $m_ctx, 'sys-log-symlink'),
+    ) {
+        eval {rmtree($path)};
+        if (my $e = $@) {
+            return $E->throw($E->DEST_CLEAN, $path, $e);
+        }
+    }
+    if ($OPTION_OF{new}) {
+        my @steps = @{$m_ctx->get_steps()};
+        for my $path (
+            _path($attrib_ref, $m_ctx, 'sys'),
+            (map {_path($attrib_ref, $m_ctx, 'target', $_)} @steps),
+        ) {
+            eval {rmtree($path)};
+            if (my $e = $@) {
+                return $E->throw($E->DEST_CLEAN, $path, $e);
+            }
+        }
+    }
+    # Loads context of previous make, if possible
+    my $prev_m_ctx = eval {_ctx_load($attrib_ref, $m_ctx)};
+    if (my $e = $@) {
+        if (    !$E->caught($e)
+            ||  !grep {$_ eq $e->get_code()} ($E->CACHE_LOAD, $E->CACHE_TYPE)
+        ) {
+            die($e);
+        }
+        $@ = undef;
+    }
+    if (defined($prev_m_ctx)) {
+        $m_ctx->set_prev_ctx($prev_m_ctx);
+    }
+    else {
+        # Creates the system directory
+        my $sys_dir_path = _path($attrib_ref, $m_ctx, 'sys');
+        eval {mkpath($sys_dir_path)};
+        if (my $e = $@) {
+            return $E->throw($E->DEST_CREATE, $sys_dir_path, $e);
+        }
+    }
+    # Diagnostic
+    $attrib_ref->{util}->event(
+        FCM::Context::Event->MAKE_DEST,
+        $m_ctx, join('@', scalar(getpwuid($<)), hostname()),
+    );
+    1;
+}
+
+# Returns the path of a named item relative to the context destination.
+sub _path {
+    my ($attrib_ref, $m_ctx, $key, @paths) = @_;
+    my %ctx = reftype($m_ctx) && reftype($m_ctx) eq 'HASH'
+        ? %{$m_ctx} : ('dest' => $m_ctx, 'name' => q{});
+    $ctx{'dest'} ||= q{};
+    $ctx{'name'} ||= q{};
+    my $path_of_key = $attrib_ref->{path_of}{$key};
+    catfile(
+        ($ctx{'dest'} ? $ctx{'dest'} : ()),
+        split(
+            q{/},
+            ($path_of_key ? sprintf($path_of_key, $ctx{'name'}) : $path_of_key),
+        ),
+        @paths,
+    );
+}
+
+# Returns an ARRAY reference containing the search paths of a named item
+# relative to the destinations of the context and its inherited contexts.
+sub _paths {
+    my ($attrib_ref, $m_ctx, $key, @paths) = @_;
+    my @dests;
+    my @ctx_list = ($m_ctx);
+    # Adds destinations from inherited contexts recursively
+    # Note: if A inherits from B and C, B from B1 and B2, and C from C1 and C2,
+    #       the search path will be A, C, C2, C1, B, B2, B1.
+    while (my $current_ctx = pop(@ctx_list)) {
+        push(@ctx_list, @{$current_ctx->get_inherit_ctx_list()});
+        push(@dests, _path($attrib_ref, $current_ctx, $key, @paths));
+    }
+    return \@dests;
+}
+
+# Saves $item in a path given by _path($attrib_ref, $m_ctx, $key, @paths).
+sub _save {
+    my ($attrib_ref, $item, $m_ctx, $key, @paths) = @_;
+    my $path = _path($attrib_ref, $m_ctx, $key, @paths);
+    my @contents
+        = (ref($item) && ref($item) eq 'ARRAY') ? (map {$_ . "\n"} @{$item})
+        :                                         ($item . "\n")
+        ;
+    $attrib_ref->{util}->file_save($path, \@contents);
+}
+
+# Removes empty directories in a tree.
+sub _tidy {
+    my ($attrib_ref, @paths) = @_;
+    # Selects only directories which are not symbolic links
+    my @items = map {[$_, undef, undef]} grep {-d && !-l} @paths;
+    while (my $item = pop(@items)) {
+        my ($path, $n_children_ref, $n_siblings_ref) = @{$item};
+        if (!defined($n_children_ref)) {
+            opendir(my $handle, $path)
+                || return $E->throw($E->DEST_CLEAN, $path, $!);
+            my @children = grep {$_ ne q{.} && $_ ne q{..}} (readdir($handle));
+            closedir($handle);
+            $n_children_ref = \scalar(@children);
+            if (@children) {
+                # Descends into directories
+                my @sub_dirs
+                    = grep {-d && !-l} map {catfile($path, $_)} @children;
+                if (@sub_dirs == @children) {
+                    # If all children are directories, it may be possible to
+                    # remove this directory later if all children are empty
+                    push(@items, [$path, $n_children_ref, $n_siblings_ref]);
+                }
+                push(@items, (map {[$_, undef, $n_children_ref]} @sub_dirs));
+            }
+        }
+        if (!${$n_children_ref}) { # i.e. directory is empty
+            rmdir($path) || return $E->throw($E->DEST_CLEAN, $path, $!);
+            if (defined($n_siblings_ref)) {
+                --${$n_siblings_ref};
+            }
+        }
+    }
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Share::Dest
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Share::Dest;
+    my $helper = FCM::System::Make::Share::Dest->new(\%attrib);
+    my $ctx = $helper->ctx_load($path, $expected_class);
+    my $path = $helper->path($m_ctx, $key);
+    # ...
+
+=head1 DESCRIPTION
+
+A helper class for manipulating the destination of a context in a FCM make
+sub-system, e.g. extract.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Returns a new instance. The %attrib should contain the following:
+
+=over 4
+
+=item dest_items
+
+An ARRAY containing the names of the items that can be created at the context
+destination.
+
+=item path_of
+
+A HASH to map the (keys) names of the items and (values) their relative paths
+(as ARRAY) in a context destination.
+
+=back
+
+=item $instance->ctx_load($path,$expected_class)
+
+Loads a storable context from $path and returns the context. The $expected_class
+is the expected class of the loaded context. The method die() if it fails to
+load the context or if the loaded context does not belong to the expected class.
+
+=item $instance->dest_done($ctx)
+
+Finalises the destination of $ctx by freezing the $ctx in the system directory,
+removing the lock file, and tidying up any empty directories created by the
+system.
+
+=item $instance->dest_init($ctx)
+
+Initialises the destination of $ctx by checking for a lock directory in the
+destination, creating a lock if possible, cleaning up items created by the
+previous make of the system if necessary, and setting up the system directory.
+
+=item $instance->path($ctx,$key,@paths)
+
+Returns the path of a named item ($key) relative to $ctx, which can either be a
+HASH reference with {'dest' => $dest, 'name' => $name}, or a scalar path
+pointing to $dest, where $dest is the root of the path and $name is the name of
+the context. If @paths are specified, they are concatenated at the end
+of the path.
+
+=item $instance->paths($ctx,$key,@paths)
+
+Returns an ARRAY reference containing the search paths of a named item ($key)
+relative to the destinations of $ctx and its inherited contexts. If @paths are
+specified, they are concatenated at the end of each returned path.
+
+=item $instance->path_of($key)
+
+Returns the template value of the named item in a make destination.
+
+=item $instance->save($item,$ctx,$key,@paths)
+
+Saves $item in a path given by $instance->path($ctx,$key,@paths). $item can be a
+string or a reference to an ARRAY of strings. A "\n" is added to the end of each
+string.
+
+=item $instance->tidy(@paths)
+
+Recursively removes empty directories in @paths.
+
+=back
+
+=head1 CONSTANTS
+
+=over 4
+
+=item %FCM::System::Make::PATH_OF
+
+A HASH containing the default values of named paths in a make destination. The
+following keys are used by the system:
+
+=over 4
+
+=item config
+
+The standard path to the configuration file.
+
+=item sys
+
+The path to the system directory.
+
+=item sys-cache
+
+The path to the system cache directory.
+
+=item sys-config-as-parsed
+
+The path to the as-parsed configuration file.
+
+=item sys-config-on-success
+
+The path to the on-success configuration file.
+
+=item sys-ctx
+
+The path to the frozen make context (for retrieval by incremental makes).
+
+=item sys-ctx-uncompressed
+
+The path to the uncompressed form of sys-ctx.
+
+=item sys-lock
+
+The path to the lock directory.
+
+=item sys-lock-info
+
+The path to the lock info file.
+
+=item target
+
+The target destination of a make.
+
+=back
+
+=back
+
+=head1 DIAGNOSTICS
+
+=head2 FCM::System::Exception
+
+The methods of this class throws this exception on errors.
+
+=head1 TODO
+
+Time-stamp the as-parsed and the on-success configuration files.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Share/Subsystem.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Share/Subsystem.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Make/Share/Subsystem.pm	(revision 5095)
@@ -0,0 +1,322 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::System::Make::Share::Subsystem;
+use base qw{Exporter};
+
+our @EXPORT = qw{
+    _config_parse
+    _config_parse_class_prop
+    _config_parse_prop
+    _config_parse_inherit_hook_prop
+    _config_unparse_class_prop
+    _config_unparse_join
+    _config_unparse_prop
+    _prop
+    _prop0
+    _props
+};
+
+use FCM::Context::ConfigEntry;
+use FCM::Context::Make::Share::Property;
+use FCM::System::Exception;
+use Storable qw{dclone};
+use Text::ParseWords qw{shellwords};
+
+use constant {PROP_DEFAULT => 0, PROP_NS_OK => 1};
+
+# Aliases
+my $E = 'FCM::System::Exception';
+
+# Parses a configuration entry into the context.
+sub _config_parse {
+    my ($attrib_ref, $ctx, $entry, $label) = @_;
+    my %config_parser_of = (
+        'prop' => \&_config_parse_prop,
+        %{$attrib_ref->{config_parser_of}},
+    );
+    if (!$label || !exists($config_parser_of{$label})) {
+        return;
+    }
+    $config_parser_of{$label}->($attrib_ref, $ctx, $entry);
+    1;
+}
+
+# Parses a configuration entry into the subsystem property.
+sub _config_parse_class_prop {
+    my ($attrib_ref, $entry, $label) = @_;
+    if ($label ne 'prop') {
+        return;
+    }
+    if (@{$entry->get_ns_list()}) {
+        return $E->throw($E->CONFIG_NS, $entry);
+    }
+    my @keys = grep {$_ ne 'class'} keys(%{$entry->get_modifier_of()});
+    if (grep {!exists($attrib_ref->{prop_of}{$_})} @keys) {
+        return $E->throw($E->CONFIG_MODIFIER, $entry);
+    }
+    for my $key (@keys) {
+        $attrib_ref->{prop_of}{$key}[PROP_DEFAULT] = $entry->get_value();
+    }
+    1;
+}
+
+# Reads the ?.prop declaration from a config entry.
+sub _config_parse_prop {
+    my ($attrib_ref, $ctx, $entry) = @_;
+    for my $key (keys(%{$entry->get_modifier_of()})) {
+        my $prop = $ctx->get_prop_of($key);
+        if (!defined($prop)) {
+            if (!defined(_prop_default($attrib_ref, $key))) {
+                return $E->throw($E->CONFIG_MODIFIER, $entry);
+            }
+            $prop = FCM::Context::Make::Share::Property->new({id => $key});
+            $ctx->get_prop_of()->{$key} = $prop;
+        }
+        my $prop_ctx;
+        if (defined($entry->get_value())) {
+            $prop_ctx = $prop->CTX_VALUE->new({value => $entry->get_value()});
+        }
+        if (!@{$entry->get_ns_list()}) {
+            @{$entry->get_ns_list()} = (q{});
+        }
+        for my $ns (@{$entry->get_ns_list()}) {
+            if ($ns && !_prop_ns_ok($attrib_ref, $key)) {
+                return $E->throw($E->CONFIG_NS, $entry);
+            }
+            if (defined($prop_ctx)) {
+                $prop->get_ctx_of()->{$ns} = $prop_ctx;
+            }
+            elsif (exists($prop->get_ctx_of()->{$ns})) {
+                delete($prop->get_ctx_of()->{$ns});
+            }
+        }
+    }
+}
+
+# A hook command for the "inherit/use" declaration, inherit properties.
+sub _config_parse_inherit_hook_prop {
+    my ($attrib_ref, $ctx, $i_ctx) = @_;
+    while (my ($key, $i_prop) = each(%{$i_ctx->get_prop_of()})) {
+        if (!defined($ctx->get_prop_of($key))) {
+            $ctx->get_prop_of()->{$key} = dclone($i_prop);
+        }
+        my %prop_ctx_of = %{$ctx->get_prop_of($key)->get_ctx_of()};
+        while (my ($ns, $i_prop_ctx) = each(%{$i_prop->get_ctx_of()})) {
+            if (    !exists($prop_ctx_of{$ns})
+                ||  $prop_ctx_of{$ns}->get_inherited()
+            ) {
+                my $prop_ctx = dclone($i_prop_ctx);
+                $prop_ctx->set_inherited(1);
+                $ctx->get_prop_of($key)->get_ctx_of()->{$ns} = $prop_ctx;
+            }
+        }
+    }
+}
+
+# Serializes a list of words.
+sub _config_unparse_join {
+    join(
+        q{ },
+        (map {my $s = $_; $s =~ s{(["'\s])}{\\$1}gxms; $s} grep {defined()} @_),
+    );
+}
+
+# Entries of the class prop settings.
+sub _config_unparse_class_prop {
+    my ($attrib_ref, $id) = @_;
+    map {
+        my $key = $_;
+        FCM::Context::ConfigEntry->new({
+            label       => join(q{.}, $id, 'prop'),
+            modifier_of => {'class' => 1, $key => 1},
+            value       => $attrib_ref->{prop_of}{$key}[PROP_DEFAULT],
+        });
+    } sort keys(%{$attrib_ref->{prop_of}});
+}
+
+# Entries of the prop settings.
+sub _config_unparse_prop {
+    my ($attrib_ref, $ctx) = @_;
+    my $label = join(q{.}, $ctx->get_id(), 'prop');
+    my %prop_of = %{$ctx->get_prop_of()};
+    map {
+        my $key = $_;
+        my $setting = $prop_of{$key};
+        map {
+            my $ns = $_;
+            my $prop_ctx = $setting->get_ctx_of()->{$ns};
+            $prop_ctx->get_inherited()
+            ? ()
+            : FCM::Context::ConfigEntry->new({
+                label       => $label,
+                modifier_of => {$key => 1},
+                ns_list     => ($ns ? [$ns] : []),
+                value       => $prop_ctx->get_value(),
+            });
+        } sort(keys(%{$setting->get_ctx_of()}));
+    } sort(keys(%prop_of));
+}
+
+# Returns the value of a named property (for a given $ns).
+sub _prop {
+    my ($attrib_ref, $id, $ctx, $ns) = @_;
+    my $setting = defined($ctx) ? $ctx->get_prop_of()->{$id} : undef;
+    if (!defined($ctx) || !defined($setting)) {
+        return _prop_default($attrib_ref, $id);
+    }
+    if (!_prop_ns_ok($attrib_ref, $id) || !$ns) {
+        my $prop_ctx = $setting->get_ctx();
+        return (
+              defined($prop_ctx) ? $prop_ctx->get_value()
+            :                      _prop_default($attrib_ref, $id)
+        );
+    }
+    my %prop_ctx_of = %{$setting->get_ctx_of()};
+    my $iter_ref
+        = $attrib_ref->{util}->ns_iter($ns, $attrib_ref->{util}->NS_ITER_UP);
+    while (defined(my $item = $iter_ref->())) {
+        if (exists($prop_ctx_of{$item}) && defined($prop_ctx_of{$item})) {
+            return $prop_ctx_of{$item}->get_value();
+        }
+    }
+    return _prop_default($attrib_ref, $id);
+}
+
+# Returns the first non-space value of a $setting for a given $ns.
+sub _prop0 {
+    (_props(@_))[0];
+}
+
+# Returns all suitable values of a $setting for a given $ns.
+sub _props {
+    my $prop = _prop(@_);
+    shellwords($prop ? $prop : q{});
+}
+
+# Returns the default value of a named property.
+sub _prop_default {
+    my ($attrib_ref, $id) = @_;
+    if (!exists($attrib_ref->{prop_of}{$id})) {
+        return;
+    }
+    $attrib_ref->{prop_of}{$id}[PROP_DEFAULT];
+}
+
+# Returns true if the given property can accept a name-space.
+sub _prop_ns_ok {
+    my ($attrib_ref, $id) = @_;
+        exists($attrib_ref->{prop_of}{$id})
+    &&  exists($attrib_ref->{prop_of}{$id}[PROP_NS_OK])
+    &&  $attrib_ref->{prop_of}{$id}[PROP_NS_OK]
+    ;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Make::Share::Subsystem
+
+=head1 SYNOPSIS
+
+    use FCM::System::Make::Share::Subsystem;
+
+=head1 DESCRIPTION
+
+Provides common "local" functions for a make subsystem.
+
+=head1 FUNCTIONS
+
+The following functions are automatically exported by this module.
+
+=over 4
+
+=item _config_parse(\%attrib,$ctx,$entry,$label)
+
+Reads a configuration $entry into the $ctx context. The $label is the label of
+the $entry, but with the prefix (which should be the same as $ctx->get_id() plus
+a dot) removed.
+
+=item _config_parse_class_prop(\%attrib,$entry,$label)
+
+Reads a configuration $entry into the subsystem default property
+$attrib{prop_of}. The $label is the label of the $entry, but with the prefix
+(the subsystem ID plus a dot) removed.
+
+=item _config_parse_prop(\%attrib,$ctx,$entry)
+
+Reads a property configuration $entry into the $ctx context. This method may
+die() with a FCM::System::Exception on error. If the property modifier is
+invalid for the given subsystem, it returns an exception with the CODE
+FCM::System::Exception->CONFIG_MODIFIER. If the property does not support a
+namespace, it returns an exception with the CODE
+FCM::System::Exception->CONFIG_NS.
+
+=item _config_parse_inherit_hook_prop(\%attrib,$ctx,$i_ctx)
+
+The $ctx context is the current subsystem context and the $i_ctx context is the
+inherited subsystem context. Inherits property settings from $i_ctx into $ctx.
+
+=item _config_unparse_join(@list)
+
+Joins the @list into a string that can be parsed again by shellwords.
+
+=item _config_unparse_class_prop(\%attrib,$id)
+
+Turns the default properties in the current subsystem into a list of
+configuration entries. $id is the ID of the current subsystem.
+
+=item _config_unparse_prop(\%attrib,$ctx)
+
+Turns the properties in $ctx into a list of configuration entries.
+
+=item _prop(\%attrib,$id,$ctx,$ns)
+
+Returns the value of property $id. If the property does not exist, it returns
+undef. If the property is not defined in $ctx, it returns the default value. If
+the property is defined in $ctx, it returns the defined value in $ctx. If $ns is
+set and a name-space is allowed for the property, it walks the name-space to
+attempt to return the nearest value of the property for the given name-space.
+
+=item _prop0(\%attrib,$id,$ctx,$ns)
+
+Shorthand for (_props(\%attrib,$id,$ctx,$ns))[0].
+
+=item _props(\%attrib,$id,$ctx,$ns)
+
+Shorthand for shellwords(_prop(\%attrib,$id,$ctx,$ns)).
+
+=back
+
+=head1 DEPENDENCIES
+
+The %attrib argument to the functions in this module may require the following
+keys to be set correctly: {config_parser_of}, {prop_of}, {util}.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Misc.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Misc.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Misc.pm	(revision 5095)
@@ -0,0 +1,345 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Misc;
+use base qw{FCM::Class::CODE};
+
+use Cwd qw{cwd};
+use FCM::Context::Event;
+use FCM::Context::Locator;
+use FCM::System::Exception;
+use FCM::Util::ConfigReader;
+use File::Path qw{mkpath rmtree};
+use File::Spec::Functions qw{catfile};
+use List::Util qw{max};
+use Text::ParseWords qw{shellwords};
+
+# The (keys) named actions of this class and (values) their implementations.
+our %ACTION_OF = (
+    browse       => \&_browse,
+    config_parse => \&_config_parse,
+    export_items => \&_export_items,
+    keyword_find => \&_keyword_find,
+);
+# Alias to exception class
+my $E = 'FCM::System::Exception';
+
+# Creates the class.
+__PACKAGE__->class({util => '&'}, {action_of => \%ACTION_OF});
+
+# Launches a web browser to display some version controlled resources.
+sub _browse {
+    my ($attrib_ref, $option_ref, @args) = @_;
+    my $UTIL = $attrib_ref->{util};
+    my @command = shellwords(
+          exists($option_ref->{browser}) ? $option_ref->{browser}
+        :                                  $UTIL->external_cfg_get('browser')
+    );
+    if (!@args) {
+        @args = (cwd());
+    }
+    for my $value (@args) {
+        my $locator = FCM::Context::Locator->new($value);
+        my $url = $UTIL->loc_browser_url($locator);
+        my %value_of = %{$UTIL->shell_simple([@command, $url])};
+        if ($value_of{rc}) {
+            return $E->throw(
+                $E->SHELL,
+                {command_list => [@command, $url], %value_of},
+                $value_of{e},
+            );
+        }
+        $attrib_ref->{util}->event(FCM::Context::Event->OUT, $value_of{o});
+    }
+    return;
+}
+
+# Parses and displays the content of a FCM configuration file.
+sub _config_parse {
+    my ($attrib_ref, $option_ref, @args) = @_;
+    my $reader_attrib_ref;
+    if (exists($option_ref->{'fcm1'})) {
+        $reader_attrib_ref = \%FCM::Util::ConfigReader::FCM1_ATTRIB;
+    }
+    for my $value (@args) {
+        my $locator = FCM::Context::Locator->new($value);
+        my $iter = $attrib_ref->{util}->config_reader(
+            $locator, $reader_attrib_ref,
+        );
+        while (my $entry = $iter->()) {
+            $attrib_ref->{util}->event(
+                FCM::Context::Event->CONFIG_ENTRY,
+                $entry,
+                exists($option_ref->{'fcm1'}),
+            );
+        }
+    }
+    return;
+}
+
+# Exports directories in a project as sequential versioned items.
+sub _export_items {
+    my ($attrib_ref, $option_ref, $location) = @_;
+    if (!$location) {
+        return $E->throw($E->EXPORT_ITEMS_SRC);
+    }
+    $location ||= q{.};
+    my $UTIL = $attrib_ref->{util};
+    # Options and arguments
+    $option_ref->{directory} ||= cwd();
+    $option_ref->{'config-file'} ||= ['fcm-export-items.cfg'];
+    my $locator = FCM::Context::Locator->new($location);
+    $UTIL->loc_as_invariant($locator);
+    # Timer
+    my $time_start = time();
+    my $timer = $UTIL->timer();
+    my %EVENT = (
+        'create' => sub {
+            $UTIL->event(FCM::Context::Event->EXPORT_ITEM_CREATE, @_);
+        },
+        'delete' => sub {
+            $UTIL->event(FCM::Context::Event->EXPORT_ITEM_DELETE, @_);
+        },
+        'timer' => sub {
+            $UTIL->event(
+                FCM::Context::Event->TIMER, 'export-items', $time_start, @_,
+            );
+        },
+    );
+    $EVENT{'timer'}->();
+    # Reads configuration file
+    my $config_reader = $attrib_ref->{util}->config_reader(
+        FCM::Context::Locator->new($option_ref->{'config-file'}->[0]),
+        {   %FCM::Util::ConfigReader::FCM1_ATTRIB,
+            event_level => $attrib_ref->{util}->util_of_report()->LOW,
+        },
+    );
+    my %conditions_of;
+    while (defined(my $entry = $config_reader->())) {
+        # Value: conditions
+        my @conditions;
+        for my $word (shellwords($entry->get_value())) {
+            my ($operator, $rev) = $word =~ qr{\A ([<>]=?|[!=]=) (.+) \z}imsx;
+            if (!$operator || !$rev) {
+                return $E->throw($E->CONFIG_VALUE, $entry);
+            }
+            push(@conditions, $operator . $rev); # FIXME: keyword?
+        }
+        # Label: targets and namespaces
+        my ($target) = $entry->get_label() =~ qr{\A (.+) / \*\z}msx;
+        if ($target) {
+            my $l_target = $UTIL->loc_cat($locator, $target);
+            $UTIL->loc_find(
+                $l_target,
+                sub {
+                    my ($l_child, $attrib_of_child_ref) = @_;
+                    if (!$attrib_of_child_ref->{is_dir}) {
+                        my $ns_of_child = $attrib_of_child_ref->{ns};
+                        my $iter
+                            = $UTIL->ns_iter($ns_of_child, $UTIL->NS_ITER_UP);
+                        $iter->(); # discard
+                        my $ns = $UTIL->ns_cat($target, $iter->());
+                        if (!exists($conditions_of{$ns})) {
+                            $conditions_of{$ns} = \@conditions;
+                        }
+                    }
+                },
+            );
+        }
+        else {
+            $conditions_of{$entry->get_label()} = \@conditions;
+        }
+    }
+    # Export
+    NS:
+    while (my ($ns, $conditions_ref) = each(%conditions_of)) {
+        # FIXME: this should be encapsulated by the locator util.
+        my @command_list = (
+            qw{svn log -q},
+            $UTIL->loc_cat($locator, $ns)->get_value(),
+        );
+        my %value_of = %{$UTIL->shell_simple(\@command_list)};
+        if ($value_of{rc}) {
+            return $E->throw(
+                $E->SHELL,
+                {command_list => \@command_list, %value_of},
+                $value_of{e},
+            );
+        }
+        my @revs = map {($_ =~ qr{\Ar(\d+)})} split("\n", $value_of{o});
+        my %v_of;
+        my $v = 0;
+        for my $rev (reverse(@revs)) {
+            $v_of{$rev} = 'v' . ++$v;
+        }
+        my %cur_v_of = %v_of;
+        # Exports only revisions matching the conditions
+        for my $condition (@{$conditions_ref}) {
+            for my $rev (keys(%cur_v_of)) {
+                if (!eval($rev . $condition)) {
+                    delete($cur_v_of{$rev});
+                }
+            }
+        }
+        # Destination directory
+        my $path = catfile($option_ref->{directory}, $ns);
+        if (-d $path) {
+            if ($option_ref->{new} || !keys(%cur_v_of)) {
+                rmtree($path);
+            }
+            else {
+                # Delete excluded revisions if they exist in incremental mode
+                if (opendir(my $handle, $path)) {
+                    while (my $item = readdir($handle)) {
+                        if (exists($v_of{$item}) && !exists($cur_v_of{$item})) {
+                            for (($item, $v_of{$item})) {
+                                my $p = catfile($path, $_);
+                                rmtree($p);
+                                $EVENT{'delete'}->($ns, $item, $p);
+                            }
+                        }
+                    }
+                    closedir($handle);
+                }
+            }
+        }
+        if (!keys(%cur_v_of)) {
+            next NS;
+        }
+        if (!-d $path) {
+            mkpath($path);
+        }
+
+        # Exports each revision, and creates symlink for each v
+        while (my ($rev, $v) = each(%cur_v_of)) {
+            my $target = catfile($option_ref->{directory}, $ns, $v);
+            if (-l $target || -f $target) {
+                unlink($target);
+                $EVENT{'delete'}->($ns, $v, $target);
+            }
+            if (!-d $target) {
+                my $url_peg_rev = $UTIL->loc_cat($locator, $ns)->get_value();
+                my ($url) = $url_peg_rev =~ qr{\A(.*?)(?:@[^@/]+)?\z}msx;
+                my @command_list = (qw{svn export -q -r}, $rev, $url, $target);
+                my %value_of = %{$UTIL->shell_simple(\@command_list)};
+                if ($value_of{rc} || !-d $target) {
+                    return $E->throw(
+                        $E->SHELL,
+                        {command_list => \@command_list, %value_of},
+                        $value_of{e},
+                    );
+                }
+                $EVENT{'create'}->($ns, $v, $target);
+            }
+            my $link = catfile($option_ref->{directory}, $ns, $rev);
+            if (-e $link && !-l $link) {
+                rmtree($link);
+                $EVENT{'delete'}->($ns, $rev, $link);
+            }
+            elsif (-l $link && readlink($link) ne $v) {
+                unlink($link);
+                $EVENT{'delete'}->($ns, $rev, $link);
+            }
+            if (!-e $link) {
+                symlink($v, $link);
+                $EVENT{'create'}->($ns, $rev, $link);
+            }
+        }
+
+        # Symbolic link to the "latest" version directory
+        my $link_of_latest = catfile($option_ref->{directory}, $ns, 'latest');
+        my $v_of_latest = $cur_v_of{max(keys(%cur_v_of))};
+        if (-e $link_of_latest && !-l $link_of_latest) {
+            rmtree($link_of_latest);
+            $EVENT{'delete'}->($ns, 'latest', $link_of_latest);
+        }
+        elsif (-l $link_of_latest && readlink($link_of_latest) ne $v_of_latest) {
+            unlink($link_of_latest);
+            $EVENT{'delete'}->($ns, 'latest', $link_of_latest);
+        }
+        if (!-l $link_of_latest) {
+            symlink($v_of_latest, $link_of_latest);
+            $EVENT{'create'}->($ns, 'latest', $link_of_latest);
+        }
+    }
+    $EVENT{'timer'}->($timer->());
+}
+
+# Searches FCM keywords.
+sub _keyword_find {
+    my ($attrib_ref, $option_ref, @args) = @_;
+    my $UTIL = $attrib_ref->{util};
+    my @entries;
+    if (@args) {
+        for my $key (@args) {
+            my $iter = $UTIL->loc_kw_iter(FCM::Context::Locator->new($key));
+            while (my $entry = $iter->()) {
+                if (!$entry->get_implied()) {
+                    $UTIL->loc_kw_load_rev_prop($entry);
+                    push(@entries, $entry);
+                }
+            }
+        }
+    }
+    else {
+        @entries = values(%{$UTIL->loc_kw_ctx()->get_entry_by_key()});
+    }
+    for my $entry (sort {$a->get_key() cmp $b->get_key()} @entries) {
+        $UTIL->event(FCM::Context::Event->KEYWORD_ENTRY, $entry);
+    }
+    return;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Misc
+
+=head1 SYNOPSIS
+
+    use FCM::System::Misc;
+    my $system = FCM::System::Misc->new(\%attrib);
+    $system->keyword_find(@args);
+
+=head1 DESCRIPTION
+
+The rest of the FCM system.
+
+=head1 METHODS
+
+Implements the browse(), config_parse(), export_items() and keyword_find()
+methods for L<FCM::System|FCM::System>. See L<FCM::System|FCM::System> for a
+description of the calling interfaces of these functions.
+
+=head1 DIAGNOSTICS
+
+=head2 FCM::System::Exception
+
+Methods of this class may throw a FCM::System::Exception.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Old.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Old.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/System/Old.pm	(revision 5095)
@@ -0,0 +1,142 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::System::Old;
+use base qw{FCM::Class::CODE};
+
+use Cwd qw{cwd};
+use FCM1::Build;
+use FCM1::Config;
+use FCM1::Extract;
+#use FCM1::ExtractConfigComparator;
+use FCM1::Keyword;
+
+my %CLASS_OF = (build => 'FCM1::Build', extract => 'FCM1::Extract');
+
+my %KEY_OF = (
+    'archive'     => 'ARCHIVE',
+    'clean'       => 'CLEAN',
+    'full'        => 'FULL',
+    'ignore-lock' => 'IGNORE_LOCK',
+    'jobs'        => 'JOBS',
+    'stage'       => 'STAGE',
+    'targets'     => 'TARGETS',
+);
+
+__PACKAGE__->class(
+    {util => '&'},
+    {   init => \&_init,
+        action_of => {
+            build          => sub {_run('build', @_)},
+            config_compare => \&_config_compare,
+            extract        => sub {_run('extract', @_)},
+        },
+    },
+);
+
+sub _init {
+    my ($attrib_ref) = @_;
+    if (!defined(FCM1::Keyword::get_util())) {
+        FCM1::Keyword::set_util($attrib_ref->{util});
+    }
+}
+
+sub _config_compare {
+    my ($attrib_ref, $option_hash_ref, @args) = @_;
+    $attrib_ref->{util}->class_load('FCM1::CmUrl');
+    $attrib_ref->{util}->class_load('FCM1::ExtractConfigComparator');
+    if (exists($option_hash_ref->{verbosity})) {
+        FCM1::Config->instance()->verbose($option_hash_ref->{verbosity});
+    }
+    my %option = %{$option_hash_ref};
+    if (exists($option{'wiki-format'})) {
+        $option{'wiki'} = delete($option{'wiki-format'});
+    }
+    my $system = FCM1::ExtractConfigComparator->new({files => \@args, %option});
+    $system->invoke();
+}
+
+sub _run {
+    my ($key, $attrib_ref, $option_hash_ref, @args) = @_;
+    if (exists($option_hash_ref->{targets})) {
+        @{$option_hash_ref->{targets}}
+            = split(qr{:}msx, join(':', @{$option_hash_ref->{targets}}));
+    }
+    if (exists($option_hash_ref->{verbosity})) {
+        FCM1::Config->instance()->verbose($option_hash_ref->{verbosity});
+    }
+    my $system = $CLASS_OF{$key}->new();
+    my $path_to_cfg = @args ? $args[0] : cwd();
+    $system->cfg()->src($path_to_cfg);
+    my %option_of;
+    while (my ($key, $value) = each(%{$option_hash_ref})) {
+        if (exists($KEY_OF{$key})) {
+            $option_of{$KEY_OF{$key}} = $value;
+        }
+    }
+    $system->invoke(%option_of);
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::System::Old
+
+=head1 SYNOPSIS
+
+    use FCM::System::Old;
+    my $system = FCM::System::Old->new();
+    $system->('extract', \%option, \@args);
+
+=head1 DESCRIPTION
+
+Provides a compatibility layer for obsolete FCM 1 functionalities.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new()
+
+Creates and returns an instance of this class.
+
+=item $instance->build(\%option,@args)
+
+Invokes the FCM 1 build system.
+
+=item $instance->config_compare(\%option,@args)
+
+Invokes the FCM 1 cmp-ext-cfg application.
+
+=item $instance->extract(\%option,@args)
+
+Invokes the FCM 1 extract system.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util.pm	(revision 5095)
@@ -0,0 +1,1050 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+
+package FCM::Util;
+use base qw{FCM::Class::CODE};
+
+use Digest::MD5;
+use Digest::SHA;
+use FCM::Context::Event;
+use FCM::Context::Locator;
+use FCM::Util::ConfigReader;
+use FCM::Util::ConfigUpgrade;
+use FCM::Util::Event;
+use FCM::Util::Exception;
+use FCM::Util::Locator;
+use FCM::Util::Reporter;
+use FCM::Util::Shell;
+use FCM::Util::TaskRunner;
+use File::Basename qw{basename dirname};
+use File::Path qw{mkpath};
+use File::Spec::Functions qw{catfile};
+use FindBin;
+use Scalar::Util qw{blessed reftype};
+use Text::ParseWords qw{shellwords};
+use Time::HiRes qw{gettimeofday tv_interval};
+
+use constant {NS_ITER_UP => 1};
+
+# The (keys) named actions of this class and (values) their implementations.
+our %ACTION_OF = (
+    cfg_init             => \&_cfg_init,
+    class_load           => \&_class_load,
+    config_reader        => _util_of_func('config_reader', 'main'),
+    external_cfg_get     => \&_external_cfg_get,
+    event                => \&_event,
+    file_checksum        => \&_file_checksum,
+    file_ext             => \&_file_ext,
+    file_head            => \&_file_head,
+    file_load            => \&_file_load,
+    file_load_handle     => \&_file_load_handle,
+    file_md5             => \&_file_md5,
+    file_save            => \&_file_save,
+    file_tilde_expand    => \&_file_tilde_expand,
+    hash_cmp             => \&_hash_cmp,
+    loc_as_invariant     => _util_of_loc_func('as_invariant'),
+    loc_as_keyword       => _util_of_loc_func('as_keyword'),
+    loc_as_normalised    => _util_of_loc_func('as_normalised'),
+    loc_as_parsed        => _util_of_loc_func('as_parsed'),
+    loc_browser_url      => _util_of_loc_func('browser_url'),
+    loc_cat              => _util_of_loc_func('cat'),
+    loc_dir              => _util_of_loc_func('dir'),
+    loc_export           => _util_of_loc_func('export'),
+    loc_export_ok        => _util_of_loc_func('export_ok'),
+    loc_exists           => _util_of_loc_func('test_exists'),
+    loc_find             => _util_of_loc_func('find'),
+    loc_kw_ctx           => _util_of_loc_func('kw_ctx'),
+    loc_kw_ctx_load      => _util_of_loc_func('kw_ctx_load'),
+    loc_kw_iter          => _util_of_loc_func('kw_iter'),
+    loc_kw_load_rev_prop => _util_of_loc_func('kw_load_rev_prop'),
+    loc_kw_prefix        => _util_of_func('locator', 'kw_prefix'),
+    loc_origin           => _util_of_loc_func('origin'),
+    loc_reader           => _util_of_loc_func('reader'),
+    loc_rel2abs          => _util_of_loc_func('rel2abs'),
+    loc_trunk_at_head    => _util_of_loc_func('trunk_at_head'),
+    loc_what_type        => _util_of_loc_func('what_type'),
+    loc_up_iter          => _util_of_loc_func('up_iter'),
+    ns_cat               => \&_ns_cat,
+    ns_common            => \&_ns_common,
+    ns_in_set            => \&_ns_in_set,
+    ns_iter              => \&_ns_iter,
+    ns_sep               => sub {$_[0]->{ns_sep}},
+    report               => _util_of_func('reporter', 'report'),
+    shell                => _util_of_func('shell', 'invoke'),
+    shell_simple         => _util_of_func('shell', 'invoke_simple'),
+    shell_which          => _util_of_func('shell', 'which'),
+    task_runner          => _util_of_func('task_runner', 'main'),
+    timer                => \&_timer,
+    uri_match            => \&_uri_match,
+    util_of_event        => _util_impl_func('event'),
+    util_of_report       => _util_impl_func('reporter'),
+    version              => \&_version,
+);
+# The default paths to the configuration files.
+our @FCM1_KEYWORD_FILES = (
+    catfile((getpwuid($<))[7], qw{.fcm}),
+);
+our @CONF_PATHS = (
+    catfile($FindBin::Bin, qw{.. etc fcm}),
+    catfile((getpwuid($<))[7], qw{.met-um fcm}),
+    catfile((getpwuid($<))[7], qw{.metomi fcm}),
+);
+our %CFG_BASENAME_OF = (
+    external => 'external.cfg',
+    keyword  => 'keyword.cfg',
+);
+# Values of external commands
+our %EXTERNAL_VALUE_OF = (
+    'browser'       => 'firefox',
+    'diff3'         => 'diff3',
+    'diff3.flags'   => '-E -m',
+    'graphic-diff'  => 'xxdiff',
+    'graphic-merge' => 'xxdiff',
+    'ssh'           => 'ssh',
+    'ssh.flags'     => '-n -oBatchMode=yes',
+    'rsync'         => 'rsync',
+    'rsync.flags'   => '-a --exclude=.* --delete-excluded --timeout=900'
+                       . ' --rsh="ssh -oBatchMode=yes"',
+);
+# The name-space separator
+our $NS_SEP = '/';
+# The (keys) named utilities and their implementation classes.
+our %UTIL_CLASS_OF = (
+    config_reader => 'FCM::Util::ConfigReader',
+    event         => 'FCM::Util::Event',
+    locator       => 'FCM::Util::Locator',
+    reporter      => 'FCM::Util::Reporter',
+    shell         => 'FCM::Util::Shell',
+    task_runner   => 'FCM::Util::TaskRunner',
+);
+
+# Alias
+my $E = 'FCM::Util::Exception';
+
+# Regular expression: match a URI
+my $RE_URI = qr/
+    \A              (?# start)
+    (               (?# capture 1, scheme, start)
+        [A-Za-z]    (?# alpha)
+        [\w\+\-\.]* (?# optional alpha, numeric, plus, minus and dot)
+    )               (?# capture 1, scheme, end)
+    :               (?# colon)
+    (.*)            (?# capture 2, opaque, rest of string)
+    \z              (?# end)
+/xms;
+
+# Creates the class.
+__PACKAGE__->class(
+    {   cfg_basename_of   => {isa => '%', default => {%CFG_BASENAME_OF}},
+        conf_paths        => {isa => '@', default => [@CONF_PATHS]},
+        event             => '&',
+        external_value_of => {isa => '%', default => {%EXTERNAL_VALUE_OF}},
+        ns_sep            => {isa => '$', default => $NS_SEP},
+        util_class_of     => {isa => '%', default => {%UTIL_CLASS_OF}},
+        util_of           => '%',
+    },
+    {init => \&_init, action_of => \%ACTION_OF},
+);
+
+# Initialises attributes.
+sub _init {
+    my ($attrib_ref, $self) = @_;
+    # Initialise the utilities
+    while (my ($key, $util_class) = each(%{$attrib_ref->{util_class_of}})) {
+        if (!defined($attrib_ref->{util_of}{$key})) {
+            _class_load($attrib_ref, $util_class);
+            $attrib_ref->{util_of}{$key} = $util_class->new({util => $self});
+        }
+    }
+    if (exists($ENV{FCM_CONF_PATH})) {
+        $attrib_ref->{conf_paths} = [shellwords($ENV{FCM_CONF_PATH})];
+    }
+}
+
+# Loads the named configuration from its configuration files.
+sub _cfg_init {
+    my ($attrib_ref, $basename, $action_ref) = @_;
+    if (exists($ENV{FCM_CONF_PATH})) {
+        $attrib_ref->{conf_paths} = [shellwords($ENV{FCM_CONF_PATH})];
+    }
+    for my $path (
+        grep {-f} map {catfile($_, $basename)} @{$attrib_ref->{conf_paths}}
+    ) {
+        my $config_reader = $ACTION_OF{config_reader}->(
+            $attrib_ref, FCM::Context::Locator->new($path),
+        );
+        $action_ref->($config_reader);
+    }
+}
+
+# Loads a class/package.
+sub _class_load {
+    my ($attrib_ref, $name, $test_method) = @_;
+    $test_method ||= 'new';
+    if (!UNIVERSAL::can($name, $test_method)) {
+        eval('require ' . $name);
+        if (my $e = $@) {
+            return $E->throw($E->CLASS_LOADER, $name, $e);
+        }
+    }
+    return $name;
+}
+
+# Invokes an event.
+sub _event {
+    my ($attrib_ref, $event, @args) = @_;
+    if (!blessed($event)) {
+        $event = FCM::Context::Event->new({code => $event, args => \@args}),
+    }
+    $attrib_ref->{'util_of'}{'event'}->main($event);
+}
+
+# Returns the value of an external tool.
+{   my $EXTERNAL_CFG_INIT;
+    sub _external_cfg_get {
+        my ($attrib_ref, $key) = @_;
+        my $value_hash_ref = $attrib_ref->{external_value_of};
+        if (!$EXTERNAL_CFG_INIT) {
+            $EXTERNAL_CFG_INIT = 1;
+            _cfg_init(
+                $attrib_ref,
+                $attrib_ref->{cfg_basename_of}{external},
+                sub {
+                    my $config_reader = shift();
+                    while (defined(my $entry = $config_reader->())) {
+                        my $k = $entry->get_label();
+                        if ($k && exists($value_hash_ref->{$k})) {
+                            $value_hash_ref->{$k} = $entry->get_value();
+                        }
+                    }
+                }
+            );
+        }
+        if (!$key || !exists($value_hash_ref->{$key})) {
+            return;
+        }
+        return $value_hash_ref->{$key};
+    }
+}
+
+# Returns the checksum of the content in a file system path.
+sub _file_checksum {
+    my ($attrib_ref, $path, $algorithm) = @_;
+    my $handle = _file_load_handle($attrib_ref, $path);
+    binmode($handle);
+    $algorithm ||= 'md5';
+    my $digest = $algorithm eq 'md5'
+        ? Digest::MD5->new() : Digest::SHA->new($algorithm);
+    $digest->addfile($handle);
+    my $checksum = $digest->hexdigest();
+    close($handle);
+    return $checksum;
+}
+
+# Returns the file extension of a file system path.
+sub _file_ext {
+    my ($attrib_ref, $path) = @_;
+    my $pos_of_dot = rindex($path, q{.});
+    if ($pos_of_dot == -1) {
+        return (wantarray() ? (undef, $path) : undef);
+    }
+    my $ext = substr($path, $pos_of_dot + 1);
+    wantarray() ? ($ext, substr($path, 0, $pos_of_dot)) : $ext;
+}
+
+# Loads the first $n lines from a file system path.
+sub _file_head {
+    my ($attrib_ref, $path, $n) = @_;
+    $n ||= 1;
+    my $handle = _file_load_handle(@_);
+    my $content = q{};
+    for (1 .. $n) {
+        $content .= readline($handle);
+    }
+    close($handle);
+    (wantarray() ? (map {$_ . "\n"} split("\n", $content)) : $content);
+}
+
+# Loads the contents from a file system path.
+sub _file_load {
+    my ($attrib_ref, $path) = @_;
+    my $handle = _file_load_handle(@_);
+    my $content = do {local($/); readline($handle)};
+    close($handle);
+    (wantarray() ? (map {$_ . "\n"} split("\n", $content)) : $content);
+}
+
+# Opens a file handle to read from a file system path.
+sub _file_load_handle {
+    my ($attrib_ref, $path) = @_;
+    open(my($handle), '<', $path) || return $E->throw($E->IO, $path, $!);
+    $handle;
+}
+
+# Returns the MD5 checksum of the content in a file system path.
+sub _file_md5 {
+    my ($attrib_ref, $path) = @_;
+    _file_checksum($attrib_ref, $path, 'md5');
+}
+
+# Saves content to a file system path.
+sub _file_save {
+    my ($attrib_ref, $path, $content) = @_;
+    if (!-e dirname($path)) {
+        eval {mkpath(dirname($path))};
+        if (my $e = $@) {
+            return $E->throw($E->IO, $path, $e);
+        }
+    }
+    open(my($handle), '>', $path) || return $E->throw($E->IO, $path, $!);
+    if (ref($content) && ref($content) eq 'ARRAY') {
+        print($handle @{$content}) || return $E->throw($E->IO, $path, $!);
+    }
+    else {
+        print($handle $content) || return $E->throw($E->IO, $path, $!);
+    }
+    close($handle) || return $E->throw($E->IO, $path, $!);
+}
+
+# Expand leading ~ and ~USER syntax in $path and return the resulting string.
+sub _file_tilde_expand {
+    my ($attrib_ref, $path) = @_;
+    $path =~ s{\A~([^/]*)}{$1 ? (getpwnam($1))[7] : (getpwuid($<))[7]}exms;
+    return $path;
+}
+
+# Compares contents of 2 HASH references.
+sub _hash_cmp {
+    my ($attrib_ref, $hash_1_ref, $hash_2_ref, $keys_only) = @_;
+    my %hash_2 = %{$hash_2_ref};
+    my %modified;
+    while (my ($key, $v1) = each(%{$hash_1_ref})) {
+        if (exists($hash_2{$key})) {
+            my $v2 = $hash_2{$key};
+            if (    !$keys_only
+                &&  (
+                        defined($v1) && defined($v2) && $v1 ne $v2
+                    ||  defined($v1) && !defined($v2)
+                    ||  !defined($v1) && defined($v2)
+                )
+            ) {
+                $modified{$key} = 0;
+            }
+            delete($hash_2{$key});
+        }
+        else {
+            $modified{$key} = -1;
+        }
+    }
+    while (my $key = each(%hash_2)) {
+        if (!exists($hash_1_ref->{$key})) {
+            $modified{$key} = 1;
+        }
+    }
+    return %modified;
+}
+
+# Concatenates 2 name-spaces.
+sub _ns_cat {
+    my ($attrib_ref, @ns_list) = @_;
+    join(
+        $attrib_ref->{ns_sep},
+        grep {$_ && $_ ne $attrib_ref->{ns_sep}} @ns_list,
+    );
+}
+
+# Returns the common parts of 2 name-spaces.
+sub _ns_common {
+    my ($attrib_ref, $ns1, $ns2) = @_;
+    my $iter1 = _ns_iter($attrib_ref, $ns1);
+    my $iter2 = _ns_iter($attrib_ref, $ns2);
+    my $common_ns = q{};
+    while (defined(my $s1 = $iter1->()) && defined(my $s2 = $iter2->())) {
+        if ($s1 ne $s2) {
+            return $common_ns;
+        }
+        $common_ns = $s1;
+    }
+    return $common_ns;
+}
+
+# Returns true if $ns is in one of the name-spaces given by keys(%set).
+sub _ns_in_set {
+    my ($attrib_ref, $ns, $ns_set_ref) = @_;
+    if (!keys(%{$ns_set_ref})) {
+        return;
+    }
+    my @ns_list;
+    my $ns_iter = _ns_iter($attrib_ref, $ns);
+    while (defined(my $n = $ns_iter->())) {
+        push(@ns_list, $n);
+    }
+    grep {exists($ns_set_ref->{$_})} @ns_list;
+}
+
+# Returns an iterator to walk up/down a name-space.
+sub _ns_iter {
+    my ($attrib_ref, $ns, $up) = @_;
+    if ($ns eq $attrib_ref->{ns_sep}) {
+        $ns = q{};
+    }
+    my @give = split($attrib_ref->{ns_sep}, $ns);
+    my @take = ();
+    my $next = q{};
+    if ($up) {
+        @give = reverse(@give);
+        $next = $ns;
+    }
+    sub {
+        my $ret = $next;
+        $next = undef;
+        if (@give) {
+            push(@take, shift(@give));
+            $next = join($attrib_ref->{ns_sep}, ($up ? reverse(@give) : @take));
+        }
+        return $ret;
+    };
+}
+
+# Returns a timer.
+sub _timer {
+    my ($attrib_ref, $start_ref) = @_;
+    $start_ref ||= [gettimeofday()];
+    sub {tv_interval($start_ref)};
+}
+
+# Matches a URI.
+sub _uri_match {
+    my ($attrib_ref, $string) = @_;
+    $string =~ $RE_URI;
+}
+
+# Returns a function to return/set the object in the "util_of" basket.
+sub _util_impl_func {
+    my ($id) = @_;
+    sub {
+        my ($attrib_ref, $value) = @_;
+        if (defined($value) && ref($value) && reftype($value) eq 'CODE') {
+            $attrib_ref->{'util_of'}{$id} = $value;
+        }
+        $attrib_ref->{'util_of'}{$id};
+    };
+}
+
+# Returns a function to delegate a method to a utility in the "util_of" basket.
+sub _util_of_func {
+    my ($id, $method) = @_;
+    sub {
+        my $attrib_ref = shift();
+        $attrib_ref->{util_of}{$id}->(($method ? ($method) : ()), @_);
+    };
+}
+
+# Returns a function to delegate a method to the locator utility.
+{   my $KEYWORD_CFG_INIT;
+    sub _util_of_loc_func {
+        my ($method) = @_;
+        sub {
+            my $attrib_ref = shift();
+            if (!$KEYWORD_CFG_INIT) {
+                $KEYWORD_CFG_INIT = 1;
+                my $config_upgrade = FCM::Util::ConfigUpgrade->new();
+                for my $path (grep {-f} @FCM1_KEYWORD_FILES) {
+                    my $config_reader = $ACTION_OF{config_reader}->(
+                        $attrib_ref,
+                        FCM::Context::Locator->new($path),
+                        \%FCM::Util::ConfigReader::FCM1_ATTRIB,
+                    );
+                    $ACTION_OF{loc_kw_ctx_load}->(
+                        $attrib_ref,
+                        sub {$config_upgrade->upgrade($config_reader->())},
+                    );
+                }
+                _cfg_init(
+                    $attrib_ref,
+                    $attrib_ref->{cfg_basename_of}{keyword},
+                    sub {$ACTION_OF{loc_kw_ctx_load}->($attrib_ref, @_)},
+                );
+            }
+            $attrib_ref->{util_of}{locator}->($method, @_);
+        };
+    }
+}
+
+# Returns the FCM version string.
+{   my $FCM_VERSION;
+    sub _version {
+        my ($attrib_ref) = @_;
+        if (!defined($FCM_VERSION)) {
+            my $fcm_home = dirname($FindBin::Bin);
+            # Try "git describe"
+            my $value_hash_ref = eval {
+                $ACTION_OF{shell_simple}->(
+                    $attrib_ref,
+                    ['git', "--git-dir=$FindBin::Bin/../.git", 'describe'],
+                );
+            };
+            if (my $e = $@) {
+                if (!$E->caught($e)) {
+                    die($e);
+                }
+                $@ = undef;
+            }
+            my $version;
+            if ($value_hash_ref->{o} && !$value_hash_ref->{rc}) {
+                chomp($value_hash_ref->{o});
+                $version = $value_hash_ref->{o};
+            }
+            else {
+                # Read fcm-version.js file
+                my $path = catfile($fcm_home, qw{doc etc fcm-version.js});
+                open(my($handle), '<', $path) || die("$path: $!");
+                my $content = do {local($/); readline($handle)};
+                close($handle);
+                ($version) = $content =~ qr{\AFCM\.VERSION="(.*)";}msx;
+            }
+            $FCM_VERSION = sprintf("%s (%s)", $version, $fcm_home);
+        }
+        return $FCM_VERSION;
+    }
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Util
+
+=head1 SYNOPSIS
+
+    use FCM::Util;
+    $u = FCM::Util->new();
+    $u->class_load('Foo');
+
+=head1 DESCRIPTION
+
+Utilities used by the FCM system.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Returns a new instance. The %attrib hash can be used configure the behaviour of
+the instance:
+
+=over 4
+
+=item conf_paths
+
+The search paths to the configuration files. The default is the value in
+@FCM::Util::CONF_PATHS.
+
+=item cfg_basename_of
+
+A HASH to map the named configuration with the base names of their paths.
+(default=%CFG_BASENAME_OF)
+
+=item external_value_of
+
+A HASH to map the named external tools with their default values.
+(default=%EXTERNAL_VALUE_OF)
+
+=item event
+
+A CODE to handle event.
+
+=item ns_sep
+
+The name space separator. (default=/)
+
+=item util_class_of
+
+A HASH to map (keys) utility names to (values) their implementation classes. See
+%FCM::System::UTIL_CLASS_OF.
+
+=item util_of
+
+A HASH to map (keys) utility names to (values) their implementation instances.
+
+=back
+
+=item $u->cfg_init($basename,\&action)
+
+Search site/user configuration given by $basename. Invoke the callback
+&action($config_reader) for each configuration file found.
+
+=item $u->class_load($name,$test_method)
+
+If $name can call $test_method, returns $name. (If $test_method is not defined,
+the default is "new".) Otherwise, calls require($name). Returns $name.
+
+=item $u->config_reader($locator,\%reader_attrib)
+
+Returns an iterator for getting the configuration entries from $locator (which
+should be an instance of L<FCM::Context::Locator|FCM::Context::Locator>.
+
+The iterator returns the next useful entry of the configuration file as an
+object of L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry>. It returns
+under if there is no more useful entry to return.
+
+The %reader_attrib may be used to override the default attributes. The HASH
+should contain a {parser} and a {processor}. The {parser} is a CODE reference to
+parse a declaration in the configuration file into an entry. The {processor} is
+a CODE reference to process the entry. If the {processor} returns true, the
+entry is considered a special entry (e.g. a variable declaration or an
+C<include> declaration) that is processed, and will not be returned by the
+iterator.
+
+The %reader_attrib can be defined using the following pre-defined sets:
+
+=over 4
+
+=item %FCM::Util::ConfigReader::FCM1_ATTRIB
+
+Using this will generate a reader for configuration files written in the FCM 1
+format.
+
+=item %FCM::Util::ConfigReader::FCM2_ATTRIB
+
+Using this will generate a reader for configuration files written in the FCM 2
+format. (default)
+
+=back
+
+In addition, $reader_attrib{event_level} can be used to adjust the event
+verbosity level.
+
+The parser and the processor are called with a %state, which contains the
+current state of the reader, and has the following elements:
+
+=over 4
+
+=item cont
+
+This is set to true if there is a continue marker at the end of the current
+line. The next line should be parsed as part of the current context.
+
+=item ctx
+
+The context of the current entry, which should be an instance of
+L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry>.
+
+=item line
+
+The content of the current line.
+
+=item stack
+
+An ARRAY reference that represents an include stack. The top of the stack
+(the final element) represents the most current file being read. An include file
+will be put on top of the stack, and removed when EOF is reached. When the stack
+is empty, the iterator is exhausted.
+
+Each element of the stack is an 4-element ARRAY reference. Element 1 is the
+L<FCM::Context::Locator|FCM::Context::Locator> object that represents the
+current file. Element 2 is the line number of the current file. Element 3 is the
+file handle for reading the current file. Element 4 is a CODE reference with an
+interface $f->($path), for turning $path from a relative location under the
+container of the current file into an absolute location.
+
+=item var
+
+A HASH reference containing the variables (from the environment and local to the
+configuration file) that can be used for substitution.
+
+=back
+
+=item $u->external_cfg_get($key)
+
+Returns the value of a named tool.
+
+=item $u->event($event,@args)
+
+Raises an event. The 1st argument $event can either be a blessed reference of
+L<FCM::Context::Event|FCM::Context::Event> or a valid event code. If the former
+is true, @args is not used, otherwise, @args should be the event arguments for
+the specified event code.
+
+=item $u->file_checksum($path, $algorithm)
+
+Returns the checksum of $path. If $algorithm is not specified, the default
+algorithm to use is MD5. Otherwise, any algorithm supported by Perl's
+Digest::SHA module can be used.
+
+=item $u->file_ext($path)
+
+Returns file extension of $path. E.g.:
+
+    my $path = '/foo/bar.baz';
+    my $extension = $u->file_ext($path); # 'baz'
+    my ($extension, $root) = $u->file_ext($path); # ('baz', '/foo/bar')
+
+=item $u->file_head($path, $n)
+
+Loads $n lines (or 1 line if $n not specified) from a $path in the file system.
+In scalar context, returns the content in a scalar. In list context, separate
+the content by the new line character "\n", and returns the resulting list.
+
+=item $u->file_load($path)
+
+Loads contents from a $path in the file system. In scalar context, returns the
+content in a scalar. In list context, separate the content by the new line
+character "\n", and returns the resulting list.
+
+=item $u->file_load_handle($path)
+
+Returns a file handle for loading contents from $path.
+
+=item $u->file_md5($path)
+
+Deprecated. Equivalent to $u->file_checksum($path, 'md5').
+
+=item $u->file_save($path, $content)
+
+Saves $content to a $path in the file system.
+
+=item $u->file_tilde_expand($path)
+
+Expand any leading "~" or "~USER" syntax to the HOME directory of the current
+user or the HOME directory of USER. Return the modified string.
+
+=item $u->hash_cmp(\%hash_1,\%hash_2,$keys_only)
+
+Compares the contents of 2 HASH references. If $keys_only is specified, only
+compares the keys. Returns a HASH where each element represents a difference
+between %hash_1 and %hash_2 - if the value is positive, the key exists in
+%hash_2 but not %hash_1, if the value is negative, the key exists in %hash_1 but
+not %hash_2, and if the value is zero, the key exists in both, but the values
+are different.
+
+=item $u->loc_as_invariant($locator)
+
+If the $locator->get_value_level() is below FCM::Context::Locator->L_INVARIANT,
+determines the invariant value of $locator, and sets its value to the result.
+Returns $locator->get_value(). 
+
+See L<FCM::Context::Locator|FCM::Context::Locator> for information on locator
+value level.
+
+=item $u->loc_as_keyword($locator)
+
+Calls $u->loc_as_normalised($locator) if $locator->get_value_level() is below
+FCM::Context::Locator->L_NORMALISED. Returns the value of the locator as an FCM
+keyword, where possible.
+
+=item $u->loc_as_normalised($locator)
+
+If the $locator->get_value_level() is below FCM::Context::Locator->L_NORMALISED,
+determines the normalised value of $locator, and sets its value to the result.
+Returns $locator->get_value().
+
+See L<FCM::Context::Locator|FCM::Context::Locator> for information on locator
+value level.
+
+=item $u->loc_as_parsed($locator)
+
+If the $locator->get_value_level() is below FCM::Context::Locator->L_PARSED,
+determines the parsed value of $locator, and sets its value to the result.
+Returns $locator->get_value().
+
+See L<FCM::Context::Locator|FCM::Context::Locator> for information on locator
+value level.
+
+=item $u->loc_browser_url($locator)
+
+Calls $u->loc_as_normalised($locator) if $locator->get_value_level() is below
+FCM::Context::Locator->L_NORMALISED. Returns the value of the locator as a
+browser URL, where possible.
+
+=item $u->loc_cat($locator,@paths)
+
+Calls $u->loc_as_parsed($locator) if $locator->get_value_level() is below
+FCM::Context::Locator->L_PARSED. Concatenates the value of the $locator with the
+given @paths according to the $locator type. Returns a new FCM::Context::Locator
+that represents the concatenated value.
+
+=item $u->loc_dir($locator)
+
+Calls $u->loc_as_parsed($locator) if $locator->get_value_level() is below
+FCM::Context::Locator->L_PARSED. Determines the "directory" name of the value of
+the $locator according to the $locator type. Returns a new FCM::Context::Locator
+that represents the resulting value.
+
+=item $u->loc_exists($locator)
+
+Calls $u->loc_as_normalised($locator) if $locator->get_value_level() is below
+FCM::Context::Locator->L_NORMALISED. Return a true value if the location
+represented by $locator exists.
+
+=item $u->loc_export($locator,$dest)
+
+Calls $u->loc_as_normalised($locator) if $locator->get_value_level() is below
+FCM::Context::Locator->L_NORMALISED. Exports the file or directory tree
+represented by $locator to a file system $dest.
+
+=item $u->loc_export_ok($locator)
+
+Calls $u->loc_as_parsed($locator) if $locator->get_value_level() is below
+FCM::Context::Locator->L_PARSED. Returns true if it is possible and safe to
+call $u->loc_export($locator).
+
+=item $u->loc_find($locator,\&callback)
+
+Searches the directory tree of $locator. Invokes &callback for each node with
+the following interface:
+
+    $callback_ref->($locator_of_child_node, \%target_attrib);
+
+where %target_attrib contains the keys:
+
+=over 4
+
+=item {is_dir}
+
+This is set to true if the child node is a directory.
+
+=item {last_modified_rev}
+
+This is set to the last modified revision of the child node, if relevant.
+
+=item {last_modified_time}
+
+This is set to the last modified time of the child node.
+
+=item {ns}
+
+This is set to the relative name-space (i.e. the relative path) of the child
+node.
+
+=back
+
+=item $u->loc_kw_ctx()
+
+Returns the keyword context (an instance of FCM::Context::Keyword).
+
+=item $u->loc_kw_ctx_load(@config_entry_iterators)
+
+Loads configuration entries into the keyword context. The
+@config_entry_iterators should be a list of CODE references, with the following
+calling interfaces:
+
+    while (my $config_entry = $config_entry_iterator->()) {
+        # ... $config_entry should be an instance of FCM::Context::ConfigEntry
+    }
+
+=item $u->loc_kw_iter($locator)
+
+Returns an iterator. When called, the iterator returns location keyword entry
+context (as an instance of
+L<FCM::Context::Keyword::Entry::Location|FCM::Context::Keyword>) for $locator
+until exhausted.
+
+    my $iterator = $u->loc_kw_iter($locator)
+    while (my $kw_ctx_entry = $iterator->()) {
+        # ... do something with $kw_ctx_entry
+    }
+
+=item $u->loc_kw_load_rev_prop($entry)
+
+Loads the revision keywords to $entry
+(L<FCM::Context::Keyword::Entry::Location|FCM::Context::Keyword>), assuming that
+$entry is not an implied location keyword, and that the keyword locator points
+to a VCS location that supports setting up revision keywords in properties.
+
+=item $u->loc_kw_prefix()
+
+Returns the prefix of a FCM keyword. This should be "fcm".
+
+=item $u->loc_origin($locator)
+
+Calls $u->loc_as_parsed($locator) if $locator->get_value_level() is below
+FCM::Context::Locator->L_PARSED. Determines the origin of $locator, and returns
+a new FCM::Context::Locator that represents the result. E.g. if $locator points
+to a Subversion working copy, it returns a new locator that represents the URL
+of the working copy.
+
+=item $u->loc_reader($locator)
+
+Calls $u->loc_as_normalised($locator) if $locator->get_value_level() is below
+FCM::Context::Locator->L_NORMALISED. Returns a file handle for reading the
+content from $locator.
+
+=item $u->loc_rel2abs($locator,$locator_base)
+
+If the value of $locator is a relative path, sets it to an absolute path base on
+the $locator_base, provided that $locator and $locator_base is the same type.
+
+=item $u->loc_trunk_at_head($locator)
+
+Returns a string to represent the relative path to the latest main tree, if it
+is relevant for $locator.
+
+=item $u->loc_what_type($locator)
+
+Sets $locator->get_type() and returns its value. Currently, this can either be
+"svn" for a locator pointing to a Subversion resource or "fs" for a locator
+pointing to a file system resource.
+
+=item $u->loc_up_iter($locator)
+
+Returns an iterator that walks up the hierarchy of the $locator, according to
+its type.
+
+=item $u->ns_cat(@name_spaces)
+
+Concatenates name-spaces and returns the result.
+
+=item $u->ns_common($ns1,$ns2)
+
+Returns the common parts of 2 name-spaces. For example, if $ns1 is
+"egg/ham/bacon" and $ns2 is "egg/ham/sausage", it should return "egg/ham".
+
+=item $u->ns_in_set($ns,\%set)
+
+Returns true if $ns is in a name-space given by the keys of %set.
+
+=item $u->ns_iter($ns,$up)
+
+Returns an iterator that walks up or down a name-space. E.g.:
+
+    $iter_ref = $u->ns_iter('a/bee/cee', $u->NS_ITER_UP);
+    while (defined(my $item = $iter_ref->())) {
+        print("[$item]");
+    }
+    # should print: [a/bee/cee][a/bee][a][]
+
+    $iter_ref = $u->ns_iter('a/bee/cee');
+    while (defined(my $item = $iter_ref->())) {
+        print("[$item]");
+    }
+    # should print: [][a][a/bee][a/bee/cee]
+
+=item $u->ns_sep()
+
+Returns the name-space separator, (i.e. normally "/").
+
+=item $u->report(\%option,$message)
+
+Reports messages using $u->util_of_report(). The default is an instance of
+L<FCM::Util::Reporter|FCM::Util::Reporter>. See
+L<FCM::Util::Reporter|FCM::Util::Reporter> for detail.
+
+=item $u->shell($command,\%action_of)
+
+Invokes the $command, which can be scalar or a reference to an ARRAY. If a
+scalar is specified, it will be separated into an array using the shellwords()
+function in L<Text::ParseWords|Text::ParseWords>. If it is a reference to an
+ARRAY, the ARRAY will be passed to open3() as is.
+
+The %action_of should contain the actions for i: standard input, e: standard
+error output and o: standard output. The default for each of these is an
+anonymous subroutinue that does nothing.
+
+Each time the pipe to the child standard input is available for writing, it will
+call $action_of{i}->(). If it returns a defined value, the value will be written
+to the pipe. If it returns undef, the pipe will be closed.
+
+Each time the pipe from the child standard (error) output is available for
+reading, it will read some values to a buffer, and invoke the callback
+$action_of{o}->($buffer) (or $action_of{e}->($buffer)). The return value of the
+callback will be ignored.
+
+On normal completion, it returns the status code of the command and raises an
+FCM::Context::Event->SHELL event:
+
+Any abnormal failure will cause an instance of FCM::Util::Exception to be
+thrown. (The return of a non-zero status code by the child is considered a
+normal completion.)
+
+=item $u->shell_simple($command)
+
+Wraps $u->shell(), and returns a HASH reference containing {e} (the
+standard error), {o} (the standard output) and {rc} (the return code).
+
+=item $u->shell_which($name)
+
+Returns the full path of an executable command $name if it can be found in the
+system PATH.
+
+=item $u->task_runner($action_code_ref,$n_workers)
+
+Returns a runner of tasks. It can be configured to work in serial (default) or
+parallel. The runner has the following methods:
+
+    $n_done = $runner->main($get_code_ref,$put_code_ref);
+    $runner->destroy();
+
+For each $task (L<FCM::Context::Task|FCM::Context::Task>) returned by the
+$get_code_ref->() iterator, invokes $action_ref->($task->get_ctx()). When
+$action_ref returns, send the $task back to the caller by calling
+$put_code_ref->($task). When it is done, the runner returns the number of tasks
+it has done.
+
+The $runner->destroy() method should be called to destroy the $runner when it is
+not longer used.
+
+=item $u->timer(\@start)
+
+Returns a CODE reference, which can be called to return the elapsed time. The
+@start argument is optional. If specified, it should be in a format as returned
+by Time::HiRes::gettimeofday(). If not specified, the current gettimeofday() is
+used.
+
+=item $u->uri_match($string)
+
+Returns true if $string is a URI. In array context, returns the scheme and the
+opague part of the URI if $string is a URI, or an empty list otherwise.
+
+=item $u->util_of_event($value)
+
+Returns and/or sets the L<FCM::Util::Event|FCM::Util::Event> object that is used
+to handle the $u->report() method.
+
+=item $u->util_of_report($value)
+
+Returns and/or sets the L<FCM::Util::Reporter|FCM::Util::Reporter> object that
+is used to handle the $u->report() method.
+
+=item $u->version()
+
+Returns the FCM version string in the form C<VERSION (BIN)> where VERSION is the
+version string returned by "git describe" or the version file and BIN is
+absolute path of the "fcm" command.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=head2 FCM::Util::Exception
+
+This exception is a sub-class of L<FCM::Exception|FCM::Exception> and is thrown
+by methods of this class on error.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/ConfigReader.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/ConfigReader.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/ConfigReader.pm	(revision 5095)
@@ -0,0 +1,609 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Util::ConfigReader;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::ConfigEntry;
+use FCM::Context::Event;
+use FCM::Context::Locator;
+use FCM::Util::Exception;
+use File::Spec::Functions qw{file_name_is_absolute};
+use Text::Balanced   qw{extract_bracketed};
+use Text::ParseWords qw{parse_line shellwords};
+
+# Alias
+our $UTIL;
+# Alias to exception class
+my $E = 'FCM::Util::Exception';
+# The variable name, which means the container of the current configuration file
+my $HERE = 'HERE';
+# Element indices in a stack item
+my ($I_LOCATOR, $I_LINE_NUM, $I_HANDLE, $I_HERE_LOCATOR) = (0 .. 3);
+# Patterns for extracting/matching strings
+my %PATTERN_OF = (
+    # Config: comment delimiter, e.g. "... #comment"
+    comment => qr/\s+ \#/xms,
+    # Config: continue, start of next line
+    cont_next => qr/
+        \A (.*?)        (?# start and capture 1, shortest of anything)
+        (\\*)           (?# capture 2, a number of backslashes)
+        \s* \z          (?# optional space until the end)
+    /xms,
+    # Config: continue, end of previous line
+    cont_prev => qr/\A \s* \\? (.*) \z/xms,
+    # Config: removal of the assignment operator at start of string
+    fcm2_equal => qr/
+        \A \s*          (?# start and optional spaces)
+        (=)             (?# capture 1, equal sign)
+        (.*) \z         (?# capture 2, rest of string)
+    /xms,
+    # Config: label of an inc statement
+    fcm1_include => qr/\Ainc\z/ixms,
+    # Config: label of an include statement
+    fcm2_include => qr/\Ainclude\z/ixms,
+    # Config: label of an include-path statement
+    fcm2_include_path => qr/\Ainclude-path\z/ixms,
+    # Config: label
+    fcm2_label => qr/
+        \A \s*          (?# start and optional spaces)
+        (\$?[\w\-\.]+)  (?# capture 1, optional dollar, then valid label)
+        (.*) \z         (?# capture 2, rest of string)
+    /xms,
+    # Config: a variable identifier in a value, e.g. "... ${var}", "$var"
+    fcm1_var => qr/
+        \A              (?# start)
+        (.*?)           (?# capture 1, shortest of anything)
+        ([\$\%])        (?# capture 2, variable sigil, dollar or percent)
+        (\{)?           (?# capture 3, curly brace start, optional)
+        ([A-z]\w+(?:::[A-z]\w+)*) (?# capture 4, variable name)
+        ((?(3)\}))      (?# capture 5, curly brace end, if started in capture 4)
+        (.*)            (?# capture 6, rest of string)
+        \z              (?# end)
+    /xms,
+    # Config: a variable identifier in a value, e.g. "... ${var}", "$var"
+    fcm2_var => qr/
+        \A              (?# start)
+        (.*?)           (?# capture 1, shortest of anything)
+        (\\*)           (?# capture 2, escapes)
+        (\$)            (?# capture 3, variable sigil, dollar)
+        (\{)?           (?# capture 4, curly brace start, optional)
+        ([A-z]\w+)      (?# capture 5, variable name)
+        ((?(4)\}))      (?# capture 6, curly brace end, if started in capture 4)
+        (.*)            (?# capture 7, rest of string)
+        \z              (?# end)
+    /xms,
+    # Config: a $HERE, ${HERE} in the beginning of a string
+    here => qr/
+        \A                  (?# start)
+        (\$HERE|\$\{HERE\}) (?# capture 1, \$HERE)
+        (\/.*)?             (?# capture 2, rest of string)
+        \z                  (?# end)
+    /xms,
+    # Config: an empty or comment line
+    ignore => qr/\A \s* (?:\#|\z)/xms,
+    # Config: comma separator
+    delim_csv => qr/\s*,\s*/xms,
+    # Config: modifier key:value separator
+    delim_mod => qr/\s*:\s*/xms,
+    # A variable name
+    var_name => qr/\A [A-Za-z_]\w* \z/xms,
+    # Config: trim value
+    trim => qr/\A \s* (.*?) \s* \z/xms,
+    # Config: trim value within braces
+    trim_brace => qr/\A [\[\{] \s* (.*?) \s* [\]\}] \z/xms,
+);
+# Default (post-)processors for a configuration entry
+our %FCM1_ATTRIB = (
+    parser    => _parse_func(\&_parse_fcm1_label, \&_parse_fcm1_var),
+    processor => sub {
+        _process_assign_func('%')->(@_)
+        ||
+        _process_include_func('fcm1_include')->(@_)
+        ||
+        _process_fcm1_label(@_)
+        ;
+    },
+);
+# Default (post-)processors for a configuration entry
+our %FCM2_ATTRIB = (
+    parser    => _parse_func(\&_parse_fcm2_label, \&_parse_fcm2_var),
+    processor => sub {
+        _process_assign_func('$', '?')->(@_)
+        ||
+        _process_include_path_func('fcm2_include_path')->(@_)
+        ||
+        _process_include_func('fcm2_include')->(@_)
+        ;
+    },
+);
+
+# Creates the class.
+__PACKAGE__->class(
+    {   event_level => '$',
+        parser      => {isa => '&', default => sub {$FCM2_ATTRIB{parser}}   },
+        processor   => {isa => '&', default => sub {$FCM2_ATTRIB{processor}}},
+        util        => '&',
+    },
+    {action_of => {main => \&_main}},
+);
+
+# Returns a configuration reader.
+sub _main {
+    my ($attrib_ref, $locator, $reader_attrib_ref) = @_;
+    if (!defined($locator)) {
+        return;
+    }
+    my %reader_attrib
+        = defined($reader_attrib_ref) ? %{$reader_attrib_ref} : ();
+    my @include_paths = exists($reader_attrib{include_paths})
+        ?  @{$reader_attrib{include_paths}} : ();
+    my %state = (
+        cont  => undef,
+        ctx   => undef,
+        line  => undef,
+        include_paths => \@include_paths,
+        stack => [[$locator, 0]],
+        var   => {},
+    );
+    my %attrib = (%{$attrib_ref}, %reader_attrib);
+    sub {_read(\%attrib, \%state)};
+}
+
+# Returns a parser for a configuration line (FCM 1 or FCM 2 format).
+sub _parse_func {
+    my ($parse_label_func, $parse_var_func) = @_;
+    sub {
+        my ($state_ref) = @_;
+        my $line
+            = $state_ref->{cont} ? $state_ref->{line}
+            :                      $parse_label_func->($state_ref)
+            ;
+        my $value
+            = $parse_var_func->($state_ref, _parse_value($state_ref, $line));
+        if ($state_ref->{ctx}->get_value()) {
+            $value = $state_ref->{ctx}->get_value() . $value;
+        }
+        $state_ref->{ctx}->set_value($value);
+        if (!$state_ref->{cont}) {
+            _parse_var_here($state_ref);
+        }
+    };
+}
+
+# Parses a configuration line label (FCM 1 format).
+sub _parse_fcm1_label {
+    my ($state_ref) = @_;
+    my ($label, $line) = split(qr{\s+}xms, $state_ref->{line}, 2);
+    $state_ref->{ctx}->set_label($label);
+    return $line;
+}
+
+# Parses a configuration line label (FCM 2 format).
+sub _parse_fcm2_label {
+    my ($state_ref) = @_;
+    my %EXTRACTOR_OF = (
+        equal    => sub {($_[0] =~ $PATTERN_OF{fcm2_equal})},
+        label    => sub {($_[0] =~ $PATTERN_OF{fcm2_label})},
+        modifier => sub {extract_bracketed($_[0], '{}')} ,
+        ns       => sub {extract_bracketed($_[0], '["]')},
+    );
+    my %ACTION_OF = (
+        equal    => sub {$_[1] || $E->throw($E->CONFIG_SYNTAX, $_[0])},
+        label    => sub {$_[0]->set_label($_[1])},
+        modifier => \&_parse_fcm2_label_modifier,
+        ns       => \&_parse_fcm2_label_ns,
+    );
+    my %EXPAND_VAR_IN = (modifier => 1, ns => 1);
+    my $line = $state_ref->{line};
+    for my $key (qw{label modifier ns equal}) {
+        $line ||= q{};
+        (my $content, $line) = $EXTRACTOR_OF{$key}->($line);
+        if ($EXPAND_VAR_IN{$key}) {
+            $content = _parse_fcm2_var($state_ref, $content);
+        }
+        $ACTION_OF{$key}->($state_ref->{ctx}, $content);
+    }
+    return $line;
+}
+
+# Parses the modifier part in a configuration line label (FCM 2 format).
+sub _parse_fcm2_label_modifier {
+    my ($ctx, $content) = @_;
+    if ($content) {
+        my ($str) = $content =~ $PATTERN_OF{trim_brace};
+        my %hash;
+        for my $item (parse_line($PATTERN_OF{delim_csv}, 0, $str)) {
+            my ($key, $value) = split($PATTERN_OF{delim_mod}, $item, 2);
+            # Note: "key1, key2: value2, ..." == "key1: 1, key2: value2, ..."
+            $hash{$key} = ($value ? $value : 1);
+        }
+        $ctx->set_modifier_of(\%hash);
+    }
+}
+
+# Parses the ns part in a configuration line label (FCM 2 format).
+sub _parse_fcm2_label_ns {
+    my ($ctx, $content) = @_;
+    if ($content) {
+        my ($str) = $content =~ $PATTERN_OF{trim_brace};
+        my @ns = map {$_ eq q{/} ? q{} : $_} parse_line(q{ }, 0, $str);
+        $ctx->set_ns_list(\@ns);
+    }
+}
+
+# Expands variables in a string in a FCM 1 configuration file.
+sub _parse_fcm1_var {
+    my ($state_ref, $value) = @_;
+    my %V = %{$state_ref->{var}};
+    my $lead = q{};
+    my $tail = $value;
+    MATCH:
+    while (defined($tail) && length($tail) > 0) {
+        my ($pre, $sigil, $br_open, $name, $br_close, $post)
+            = map {defined($_) ? $_ : q{}} ($tail =~ $PATTERN_OF{fcm1_var});
+        if (!$name) {
+            return $lead . $tail;
+        }
+        $tail = $post;
+        my $symbol = $sigil . $br_open . $name . $br_close;
+        my $substitute
+            = $name eq $HERE                       ? $symbol
+            : $sigil eq '$' && exists($ENV{$name}) ? $ENV{$name}
+            : $sigil eq '%' && exists($V{$name})   ? $V{$name}
+            :                                        undef
+            ;
+        if (!defined($substitute)) {
+            $UTIL->event(
+                FCM::Context::Event->CONFIG_VAR_UNDEF,
+                $state_ref->{ctx},
+                $symbol,
+            );
+        }
+        $substitute ||= $symbol;
+        $lead .= $pre . $substitute;
+    }
+    return $lead;
+}
+
+# Expands variables in a string in a FCM 2 configuration file.
+sub _parse_fcm2_var {
+    my ($state_ref, $value) = @_;
+    my %V = (%ENV, %{$state_ref->{var}});
+    my $lead = q{};
+    my $tail = $value;
+    while (defined($tail) && length($tail) > 0) {
+        my ($pre, $esc, $sigil, $br_open, $name, $br_close, $post)
+            = map {defined($_) ? $_ : q{}} ($tail =~ $PATTERN_OF{fcm2_var});
+        if (!$name) {
+            return $lead . $tail;
+        }
+        $tail = $post;
+        my $symbol = $sigil . $br_open . $name . $br_close;
+        my $substitute
+            = $name eq $HERE           ? $symbol
+            : $esc && length($esc) % 2 ? $symbol
+            : exists($V{$name})        ? $V{$name}
+            :                            undef
+            ;
+        if (!defined($substitute)) {
+            return $E->throw(
+                $E->CONFIG_VAR_UNDEF, $state_ref->{ctx}, "undef($symbol)",
+            );
+        }
+        $lead .= $pre . substr($esc, 0, length($esc) / 2) . $substitute;
+    }
+    return $lead;
+}
+
+# Parses the value part of a configuration line.
+sub _parse_value {
+    my ($state_ref, $line) = @_;
+    $line ||= q{};
+    my ($value) = parse_line($PATTERN_OF{comment}, 1, $line);
+    $value ||= q{};
+    chomp($value);
+    ($value) = $value =~ $PATTERN_OF{$state_ref->{cont} ? 'cont_prev' : 'trim'};
+    $state_ref->{cont} = q{};
+    if ($value) {
+        my ($lead, $tail) = $value =~ $PATTERN_OF{cont_next};
+        if ($tail && length($tail) % 2) {
+            $value = $lead;
+            $state_ref->{cont} = $tail;
+        }
+    }
+    return $value;
+}
+
+# Expands the leading $HERE variable in the value of a configuration entry.
+sub _parse_var_here {
+    my ($state_ref) = @_;
+    my @values = shellwords($state_ref->{ctx}->get_value());
+    if (!grep {$_ =~ $PATTERN_OF{here}} @values) {
+        return;
+    }
+    VALUE:
+    for my $value (@values) {
+        my ($head, $tail)
+            = map {defined($_) ? $_ : q{}} $value =~ $PATTERN_OF{here};
+        if (!$head) {
+            next VALUE;
+        }
+        $tail = index($tail, '/') == 0 ? substr($tail, 1) : q{}; # FIXME
+        my $here = $state_ref->{stack}->[-1]->[$I_HERE_LOCATOR];
+        $value = $UTIL->loc_cat($here, $tail)->get_value();
+    }
+    $state_ref->{ctx}->set_value(join(
+        q{ },
+        map {my $s = $_; $s =~ s{(['"\s])}{\\$1}gmsx; $s} @values,
+    ));
+}
+
+# Returns a function to process a variable assignment. If
+# $assign_if_undef_modifier is specified and is present in the declaration, only
+# assign a variable if it is not yet defined.
+sub _process_assign_func {
+    my ($sigil, $assign_if_undef_modifier) = @_;
+    sub {
+        my ($state_ref) = @_;
+        my $ctx = $state_ref->{ctx};
+        if (index($ctx->get_label(), $sigil) != 0) { # not a variable assignment
+            return;
+        }
+        my $name = substr($ctx->get_label(), length($sigil));
+        if ($name !~ $PATTERN_OF{var_name}) {
+            return $E->throw($E->CONFIG_SYNTAX, $state_ref->{ctx});
+        }
+        if ($name eq $HERE) {
+            return $E->throw($E->CONFIG_USAGE, $state_ref->{ctx});
+        }
+        if (    !$assign_if_undef_modifier
+            ||  !exists($ctx->get_modifier_of()->{$assign_if_undef_modifier})
+            ||  !exists($ENV{$name}) && !exists($state_ref->{var}{$name})
+        ) {
+            $state_ref->{var}{$name} = $ctx->get_value();
+        }
+        return 1;
+    }
+}
+
+# Processes a FCM 1 label.
+sub _process_fcm1_label {
+    my ($state_ref) = @_;
+    $state_ref->{var}{$state_ref->{ctx}->get_label()}
+        = $state_ref->{ctx}->get_value();
+    return;
+}
+
+# Processes an include-path declaration.
+sub _process_include_path_func {
+    my ($key) = @_;
+    my $PATTERN = $PATTERN_OF{$key};
+    sub {
+        my ($state_ref) = @_;
+        if ($state_ref->{ctx}->get_label() !~ $PATTERN) {
+            return;
+        }
+        my $M = $state_ref->{ctx}->get_modifier_of();
+        my $type = exists($M->{type}) ? $M->{type} : undef;
+        if (exists($M->{'+'})) {
+            push(@{$state_ref->{include_paths}}, (
+                map {
+                    FCM::Context::Locator->new($_, {type => $type});
+                } shellwords($state_ref->{ctx}->get_value()),
+            )),
+        }
+        else {
+            $state_ref->{include_paths} = [
+                map {
+                    FCM::Context::Locator->new($_, {type => $type});
+                } shellwords($state_ref->{ctx}->get_value())
+            ],
+        }
+        return 1;
+    };
+}
+
+# Processes an include declaration.
+sub _process_include_func {
+    my ($key) = @_;
+    my $PATTERN = $PATTERN_OF{$key};
+    sub {
+        my ($state_ref) = @_;
+        if ($state_ref->{ctx}->get_label() !~ $PATTERN) {
+            return;
+        }
+        my $M = $state_ref->{ctx}->get_modifier_of();
+        my $type = exists($M->{type}) ? $M->{type} : undef;
+        push(@{$state_ref->{stack}}, (map {
+            my $name = $_;
+            my $locator;
+            if (    $UTIL->uri_match($name)
+                ||  file_name_is_absolute($name)
+            ) {
+                $locator = FCM::Context::Locator->new($name, {type => $type});
+            }
+            if (!defined($locator)) {
+                HEAD:
+                for my $head (
+                    $state_ref->{stack}->[-1]->[$I_HERE_LOCATOR],
+                    @{$state_ref->{include_paths}},
+                ) {
+                    my $locator_at_head = $UTIL->loc_cat($head, $name);
+                    if ($UTIL->loc_exists($locator_at_head)) {
+                        $locator = $locator_at_head;
+                        last HEAD;
+                    }
+                }
+            }
+            if (!defined($locator)) {
+                return $E->throw(
+                    $E->CONFIG_LOAD, $state_ref->{stack}, "include=$name",
+                );
+            }
+            [$locator, 0, undef, undef];
+        } shellwords($state_ref->{ctx}->get_value())));
+        return 1;
+    };
+}
+
+# Reads the next entry of a configuration file.
+sub _read {
+    my ($attrib_ref, $state_ref) = @_;
+    local($UTIL) = $attrib_ref->{util};
+    STACK:
+    while (@{$state_ref->{stack}}) {
+        my $S = $state_ref->{stack}->[-1];
+        # Open a file handle for the top of the stack, if necessary
+        if (!defined($S->[$I_HANDLE])) {
+            eval {
+                # Check for cyclic dependency
+                for my $i (-scalar(@{$state_ref->{stack}}) .. -2) {
+                    my $value = $UTIL->loc_as_invariant(
+                        $state_ref->{stack}->[$i]->[$I_LOCATOR],
+                    );
+                    if ($value eq $UTIL->loc_as_invariant($S->[$I_LOCATOR])) {
+                        return $E->throw($E->CONFIG_CYCLIC, $state_ref->{stack});
+                    }
+                }
+                $S->[$I_HANDLE] = $UTIL->loc_reader($S->[$I_LOCATOR]);
+                $S->[$I_HERE_LOCATOR] = $UTIL->loc_dir($S->[$I_LOCATOR]);
+            };
+            if (my $e = $@) {
+                if ($E->caught($e) && $e->get_code() eq $E->CONFIG_CYCLIC) {
+                    die($e);
+                }
+                return $E->throw($E->CONFIG_LOAD, $state_ref->{stack}, $e);
+            }
+            $UTIL->event(
+                FCM::Context::Event->CONFIG_OPEN,
+                _stack_cp($state_ref->{stack}),
+                $attrib_ref->{event_level},
+            );
+        }
+        # Read a line and parse it
+        LINE:
+        while ($state_ref->{line} = readline($S->[$I_HANDLE])) {
+            if ($state_ref->{line} =~ $PATTERN_OF{ignore}) {
+                next LINE;
+            }
+            $S->[$I_LINE_NUM] = $.;
+            if (!$state_ref->{cont}) {
+                $state_ref->{ctx} = FCM::Context::ConfigEntry->new({
+                    stack => _stack_cp($state_ref->{stack}),
+                });
+            }
+            $attrib_ref->{parser}->($state_ref);
+            if (!$state_ref->{cont}) {
+                if ($attrib_ref->{processor}->($state_ref)) {
+                    next STACK;
+                }
+                return $state_ref->{ctx};
+            }
+        }
+        # At end of file
+        if ($state_ref->{cont}) {
+            return $E->throw($E->CONFIG_CONT_EOF, $state_ref->{ctx});
+        }
+        close($state_ref->{stack}->[-1]->[$I_HANDLE]);
+        $state_ref->{stack}->[-1]->[$I_HANDLE] = undef; # free the memory
+        pop(@{$state_ref->{stack}});
+    }
+    return;
+}
+
+# Copies a stack, selecting only the and the line number.
+sub _stack_cp {
+    [map {[@{$_}[$I_LOCATOR, $I_LINE_NUM]]} @{$_[0]}];
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Util::Config
+
+=head1 SYNOPSIS
+
+    use FCM::Util;
+    my $util = FCM::Util->new(\%attrib);
+    # ... time passes, and now we want to read a FCM 1 config
+    my ($locator, $reader);
+    $locator = FCM::Context::Locator->new($path_to_an_fcm1_config);
+    $reader
+        = $util->config_reader($locator, \%FCM::Util::ConfigReader::FCM1_ATTRIB);
+    while (my $entry = $reader->()) {
+        # ...
+    }
+    # ... time passes, and now we want to read a FCM 2 config
+    $locator = FCM::Context::Locator->new($path_to_an_fcm2_config);
+    $reader = $util->config_reader($locator);
+    while (my $entry = $reader->()) {
+        # ...
+    }
+
+=head1 DESCRIPTION
+
+This module is part of L<FCM::Util|FCM::Util>. Provides a function to generate
+configuration file readers.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Returns a new new instance. The %attrib must contain the following:
+
+=over 4
+
+=item {parser}
+
+A CODE reference to parse the lines in a configuration file into entry contexts.
+It should have a calling interface $f->(\%state). (See L</STATE> for a
+description of %state.) The return value is ignored.
+
+=item {processor}
+
+A CODE reference to post-process each entry context. It should have a calling
+interface $f->(\%state). (See L</STATE> for a description of %state.) The
+processor should return true if the current entry has been processed and is no
+longer considered useful for the user.
+
+=item {util}
+
+The L<FCM::Util|FCM::Util> object, which initialises this class.
+
+=back
+
+=back
+
+See the description of the config_reader() method in L<FCM::Util|FCM::Util> for
+detail.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/ConfigUpgrade.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/ConfigUpgrade.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/ConfigUpgrade.pm	(revision 5095)
@@ -0,0 +1,136 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::Util::ConfigUpgrade;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::ConfigEntry;
+
+my %DECL_PATTERN_OF = (
+    browser_mapping => qr{\A set::browser_mapping(?:_default|:: ([^:]+)):: (.+) \z}ixms,
+    keyword_loc     => qr{\A set::(?:repos|url):: (.+) \z}ixms,
+    keyword_rev     => qr{\A set::revision:: ([^:]+) :: (.+) \z}ixms,
+);
+my @UPGRADE_FUNCS = (
+    \&_upgrade_browser_mapping_decl,
+    \&_upgrade_keyword_loc_decl,
+    \&_upgrade_keyword_rev_decl,
+);
+
+# Creates the class.
+__PACKAGE__->class({}, {action_of => {upgrade => \&_upgrade}});
+
+sub _upgrade {
+    my ($attrib_ref, $config_entry) = @_;
+    if (!defined($config_entry)) {
+        return;
+    }
+    for my $func (@UPGRADE_FUNCS) {
+        $func->($config_entry);
+        if ($func->($config_entry)) {
+            return $config_entry;
+        }
+    }
+    return $config_entry;
+}
+
+# Upgrades a browser mapping declaration.
+sub _upgrade_browser_mapping_decl {
+    my ($config_entry) = @_;
+    my ($ns, $key)
+        = $config_entry->get_label() =~ $DECL_PATTERN_OF{browser_mapping};
+    if (!$key) {
+        return;
+    }
+    $config_entry->set_label(
+          $key eq 'browser_url_template' ? 'browser.loc-tmpl'
+        : $key eq 'browser_rev_template' ? 'browser.rev-tmpl'
+        :                                  'browser.comp-pat'
+    );
+    if ($ns) {
+        $config_entry->set_ns_list([$ns]);
+    }
+}
+
+# Upgrades a location keyword declaration.
+sub _upgrade_keyword_loc_decl {
+    my ($config_entry) = @_;
+    my ($ns) = $config_entry->get_label() =~ $DECL_PATTERN_OF{keyword_loc};
+    if (!$ns) {
+        return;
+    }
+    $config_entry->set_label('location');
+    $config_entry->get_modifier_of()->{primary} = 1;
+    $config_entry->set_ns_list([$ns]);
+}
+
+# Upgrades a revision keyword declaration.
+sub _upgrade_keyword_rev_decl {
+    my ($config_entry) = @_;
+    my ($ns, $key) = $config_entry->get_label() =~ $DECL_PATTERN_OF{keyword_rev};
+    if (!$ns || !$key) {
+        return;
+    }
+    $config_entry->set_label('revision');
+    $config_entry->set_ns_list([$ns, $key]);
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Util::ConfigUpgrade
+
+=head1 SYNOPSIS
+
+    use FCM::Util::ConfigUpgrade;
+    $upgrade = FCM::Util::ConfigUpgrade->new();
+    if (!$upgrade->($entry)) {
+        die($entry->get_label(), ": cannot upgrade.\n");
+    }
+    # ... do something with $entry
+
+=head1 DESCRIPTION
+
+Provides a utility to upgrade FCM 1 configuration to FCM 2 configuration.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new()
+
+Creates and returns a new instance of this utility.
+
+=item $util->($entry)
+
+Upgrades the content of $entry, where possible. Only keyword related
+declarations in the FCM 1 common configuration files are currently supported.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Event.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Event.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Event.pm	(revision 5095)
@@ -0,0 +1,1251 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Util::Event;
+use base qw{FCM::Class::CODE};
+
+use Data::Dumper qw{Dumper};
+use FCM::Context::Event;
+use File::Basename qw{basename};
+use List::Util qw{first};
+use POSIX qw{strftime};
+use Scalar::Util qw{blessed};
+
+my $CTX = 'FCM::Context::Event';
+my $IS_MULTI_LINE = 1;
+
+# Event keys and their actions.
+my %ACTION_OF = (
+    $CTX->CM_ABORT                      => \&_event_cm_abort,
+    $CTX->CM_BRANCH_CREATE_SOURCE       => _func('cm_branch_create_source'),
+    $CTX->CM_BRANCH_LIST                => \&_event_cm_branch_list,
+    $CTX->CM_COMMIT_MESSAGE             => \&_event_cm_commit_message,
+    $CTX->CM_CONFLICT_TEXT              => _func('cm_conflict_text'),
+    $CTX->CM_CONFLICT_TEXT_SKIP         => \&_event_cm_conflict_text_skip,
+    $CTX->CM_CONFLICT_TREE              => _func('cm_conflict_tree'),
+    $CTX->CM_CONFLICT_TREE_SKIP         => \&_event_cm_conflict_tree_skip,
+    $CTX->CM_CONFLICT_TREE_TIME_WARN    => \&_event_cm_conflict_tree_time_warn,
+    $CTX->CM_CREATE_TARGET              => _func('cm_create_target'),
+    $CTX->CM_LOG_EDIT                   => _func('cm_log_edit'),
+    $CTX->CONFIG_OPEN                   => \&_event_config_open,
+    $CTX->CONFIG_ENTRY                  => \&_event_config_entry,
+    $CTX->CONFIG_VAR_UNDEF              => \&_event_config_var_undef,
+    $CTX->E                             => \&_event_e,
+    $CTX->EXPORT_ITEM_CREATE            => _func('export_item_create'),
+    $CTX->EXPORT_ITEM_DELETE            => _func('export_item_delete'),
+    $CTX->FCM_VERSION                   => _func('fcm_version'),
+    $CTX->KEYWORD_ENTRY                 => \&_event_keyword_entry,
+    $CTX->MAKE_BUILD_SHELL_OUT          => \&_event_make_build_shell_out,
+    $CTX->MAKE_BUILD_SOURCE_ANALYSE     => \&_event_make_build_source_analyse,
+    $CTX->MAKE_BUILD_SOURCE_SUMMARY     => _func('make_build_source_summary'),
+    $CTX->MAKE_BUILD_TARGET_DONE        => \&_event_make_build_target_done,
+    $CTX->MAKE_BUILD_TARGET_FAIL        => \&_event_make_build_target_fail,
+    $CTX->MAKE_BUILD_TARGET_FROM_NS     => \&_event_make_build_target_from_ns,
+    $CTX->MAKE_BUILD_TARGET_SELECT      => \&_event_make_build_target_select,
+    $CTX->MAKE_BUILD_TARGET_SELECT_TIMER=> _func('make_build_target_select_t'),
+    $CTX->MAKE_BUILD_TARGET_MISSING_DEP => \&_event_make_build_target_missing_dep,
+    $CTX->MAKE_BUILD_TARGET_STACK       => \&_event_make_build_target_stack,
+    $CTX->MAKE_BUILD_TARGET_SUMMARY     => _func('make_build_target_sum'),
+    $CTX->MAKE_BUILD_TARGET_TASK_SUMMARY=> _func('make_build_target_task_sum'),
+    $CTX->MAKE_BUILD_TARGETS_FAIL       => \&_event_make_build_targets_fail,
+    $CTX->MAKE_DEST                     => \&_event_make_dest,
+    $CTX->MAKE_EXTRACT_PROJECT_TREE     => \&_event_make_extract_project_tree,
+    $CTX->MAKE_EXTRACT_RUNNER_SUMMARY   => \&_event_make_extract_runner_summary,
+    $CTX->MAKE_EXTRACT_SYMLINK          => \&_event_make_extract_symlink,
+    $CTX->MAKE_EXTRACT_TARGET           => \&_event_make_extract_target,
+    $CTX->MAKE_EXTRACT_TARGET_SUMMARY   => \&_event_make_extract_target_summary,
+    $CTX->MAKE_MIRROR                   => \&_event_make_mirror,
+    $CTX->OUT                           => \&_event_out,
+    $CTX->SHELL                         => \&_event_shell,
+    $CTX->TASK_WORKERS                  => \&_event_task_workers,
+    $CTX->TIMER                         => \&_event_timer,
+);
+# Helper for "_event_e", list of exception classes and their formatters.
+our @E_FORMATTERS = (
+    ['FCM1::Cm::Exception'    , \&_format_e_cm            ],
+    ['FCM1::CLI::Exception'   , sub {$_[0]->get_message()}],
+    ['FCM::Class::Exception' , \&_format_e_class         ],
+    ['FCM::CLI::Exception'   , \&_format_e_cli           ],
+    ['FCM::System::Exception', \&_format_e_sys           ],
+    ['FCM::Util::Exception'  , \&_format_e_util          ],
+);
+# Error format strings for FCM1::Cm::Exception.
+our %E_CM_FORMAT_FOR = (
+    DIFF_PROJECTS     => "%s (target) and %s (source) are not related.\n",
+    INVALID_BRANCH    => "%s: not a valid URL of a standard FCM branch.\n",
+    INVALID_PROJECT   => "%s: not a valid URL of a standard FCM project.\n",
+    INVALID_TARGET    => "%s: not a valid working copy or URL.\n",
+    INVALID_URL       => "%s: not a valid URL.\n",
+    INVALID_WC        => "%s: not a valid working copy.\n",
+    MERGE_REV_INVALID => "%s: not a revision in the available merge list.\n",
+    MERGE_SELF        => "%s: cannot be merged to its own working copy: %s.\n",
+    MERGE_UNRELATED   => "%s: target and %s: source not directly related.\n",
+    MERGE_UNSAFE      => "%s: source contains changes outside the target"
+                         . " sub-directory. Please merge with a full tree.\n",
+    MKPATH            => "%s: cannot create directory.\n",
+    NOT_EXIST         => "%s: does not exist.\n",
+    PARENT_NOT_EXIST  => "%s: parent %s no longer exists.\n",
+    RMTREE            => "%s: cannot remove.\n",
+    ST_CONFLICT       => "File(s) in conflicts:\n%s",
+    ST_MISSING        => "File(s) missing:\n%s",
+    ST_OUT_OF_DATE    => "File(s) out of date:\n%s",
+    SWITCH_UNSAFE     => "%s: merge template exists."
+                         . " Please remove before retrying.\n",
+    WC_INVALID_BRANCH => "%s: not a working copy of a standard FCM branch.\n",
+    WC_URL_NOT_EXIST  => "%s: working copy URL does not exists at HEAD.\n",
+);
+# Helper for "_format_e_sys", formatters based on exception code.
+our %E_SYS_FORMATTER_FOR = (
+    BUILD_SOURCE     => _format_e_func('e_sys_build_source'),
+    BUILD_SOURCE_SYN => _format_e_func('e_sys_build_source_syn'),
+    BUILD_TARGET     => \&_format_e_sys_build_target,
+    BUILD_TARGET_BAD => _format_e_func('e_sys_build_target_bad', $IS_MULTI_LINE),
+    BUILD_TARGET_CYC => \&_format_e_sys_build_target_cyc,
+    BUILD_TARGET_DEP => \&_format_e_sys_build_target_dep,
+    BUILD_TARGET_DUP => \&_format_e_sys_build_target_dup,
+    CACHE_LOAD       => _format_e_func('e_sys_cache_load'),
+    CACHE_TYPE       => _format_e_func('e_sys_cache_type'),
+    CM_ALREADY_EXIST => _format_e_func('e_sys_cm_already_exist'),
+    CM_ARG           => _format_e_func('e_sys_cm_arg'),
+    CM_BRANCH_NAME   => _format_e_func('e_sys_cm_branch_name'),
+    CM_BRANCH_SOURCE => _format_e_func('e_sys_cm_branch_source'),
+    CM_CHECKOUT      => _format_e_func('e_sys_cm_checkout'),
+    CM_LOG_EDIT_NULL => _format_e_func('e_sys_cm_log_edit_null'),
+    CM_LOG_EDIT_DELIMITER => _format_e_func('e_sys_cm_log_edit_delimiter'),
+    CM_OPT_ARG       => _format_e_func('e_sys_cm_opt_arg'),
+    CM_PROJECT_NAME  => _format_e_func('e_sys_cm_project_name'),
+    CM_REPOSITORY    => _format_e_func('e_sys_cm_repository'),
+    CONFIG_CONFLICT  => _format_e_sys_config_func('conflict'),
+    CONFIG_INHERIT   => _format_e_sys_config_func('inherit'),
+    CONFIG_MODIFIER  => _format_e_sys_config_func('modifier'),
+    CONFIG_NS        => _format_e_sys_config_func('ns'),
+    CONFIG_NS_VALUE  => _format_e_sys_config_func('ns_value'),
+    CONFIG_UNKNOWN   => _format_e_sys_config_func('unknown'),
+    CONFIG_VALUE     => _format_e_sys_config_func('value'),
+    CONFIG_VERSION   => _format_e_sys_config_func('version'),
+    COPY             => _format_e_func('e_sys_copy'),
+    DEST_CLEAN       => _format_e_func('e_sys_dest_clean'),
+    DEST_CREATE      => _format_e_func('e_sys_dest_create'),
+    DEST_LOCK        => _format_e_func('e_sys_dest_lock'),
+    DEST_LOCKED      => _format_e_func('e_sys_dest_locked'),
+    EXPORT_ITEMS_SRC => _format_e_func('e_sys_export_items_src'),
+    EXTRACT_LOC_BASE => _format_e_func('e_sys_extract_loc_base'),
+    EXTRACT_MERGE    => \&_format_e_sys_extract_merge,
+    EXTRACT_NS       => _format_e_func('e_sys_extract_ns', $IS_MULTI_LINE),
+    MIRROR           => \&_format_e_sys_mirror,
+    MIRROR_NULL      => _format_e_func('e_sys_mirror_null'),
+    MIRROR_SOURCE    => _format_e_func('e_sys_mirror_source', $IS_MULTI_LINE),
+    MIRROR_TARGET    => _format_e_func('e_sys_mirror_target'),
+    MAKE             => _format_e_func('e_sys_make'),
+    MAKE_ARG         => \&_format_e_sys_make_arg,
+    MAKE_CFG         => _format_e_func('e_sys_make_cfg'),
+    MAKE_CFG_FILE    => _format_e_func('e_sys_make_cfg_file'),
+    MAKE_PROP_NS     => \&_format_e_sys_make_prop_ns,
+    MAKE_PROP_VALUE  => \&_format_e_sys_make_prop_value,
+    SHELL            => \&_format_e_sys_shell,
+);
+# Helper for "_format_e_util", formatters based on exception code.
+our %E_UTIL_FORMATTER_FOR = (
+    CLASS_LOADER         => _format_e_func('e_util_class_loader'),
+    CONFIG_CONT_EOF      => _format_e_util_config_func('eof'),
+    CONFIG_CYCLIC        => _format_e_util_config_stack_func('cyclic'),
+    CONFIG_LOAD          => _format_e_util_config_stack_func('load'),
+    CONFIG_SYNTAX        => _format_e_util_config_func('syntax'),
+    CONFIG_USAGE         => _format_e_util_config_func('usage'),
+    CONFIG_VAR_UNDEF     => _format_e_util_config_func('var_undef'),
+    IO                   => _format_e_func('e_util_io'),
+    LOCATOR_AS_INVARIANT => _format_e_util_locator_func(''),
+    LOCATOR_BROWSER_URL  => _format_e_util_locator_func('_browser_url'),
+    LOCATOR_FIND         => _format_e_util_locator_func(''),
+    LOCATOR_KEYWORD_LOC  => _format_e_util_locator_func('_keyword_loc'),
+    LOCATOR_KEYWORD_REV  => _format_e_util_locator_func('_keyword_rev'),
+    LOCATOR_READER       => _format_e_util_locator_func('_reader'),
+    LOCATOR_TYPE         => _format_e_util_locator_func('_type'),
+    SHELL_OPEN3          => _format_e_util_shell_func('_open3'),
+    SHELL_OS             => _format_e_util_shell_func('_os'),
+    SHELL_SIGNAL         => _format_e_util_shell_func('_signal'),
+    SHELL_WHICH          => _format_e_util_shell_func('_which'),
+);
+# Alias
+our $R;
+# Named diagnostic strings
+our %S = (
+    # ERROR DIAGNOSTICS
+    e_class                      => '%s: %s => %s: internal error at %s:%d',
+    e_cli_app                    => '%s: unknown command,'
+                                    . ' type \'%s help\' for help',
+    e_cli_opt                    => '%s: incorrect usage,'
+                                    . ' type \'%s help %1$s\' for help',
+    e_sys_build_source           => '%s: source does not exist',
+    e_sys_build_source_syn       => '%s(%d): syntax error',
+    e_sys_build_target           => '%s: target not found after an update:',
+    e_sys_build_target_1         => '%s: expect target file',
+    e_sys_build_target_bad       => '%s: don\'t know how to build specified'
+                                    . ' target',
+    e_sys_build_target_cyclic    => '%s: target depends on itself',
+    e_sys_build_target_dep       => '%s: bad or missing dependency (type=%s)',
+    e_sys_build_target_dup       => '%s: same target from [%s]',
+    e_sys_build_target_stack     => '    required by: %s',
+    e_sys_cache_load             => '%s: cannot retrieve cache',
+    e_sys_cache_type             => '%s: unexpected cache type',
+    e_sys_cm_already_exist       => '%s: already exists',
+    e_sys_cm_arg                 => '%s: bad argument',
+    e_sys_cm_branch_name         => '%s: invalid branch name',
+    e_sys_cm_branch_source       => '%s: invalid branch source',
+    e_sys_cm_checkout            => '%s: is already a working copy of %s',
+    e_sys_cm_log_edit_delimiter  => '%sthe above log delimiter is altered',
+    e_sys_cm_log_edit_null       => 'log message is empty',
+    e_sys_cm_opt_arg             => '%s=%s: bad option argument',
+    e_sys_cm_project_name        => '%s: invalid project name',
+    e_sys_cm_repository          => '%s: invalid repository',
+    e_sys_config_conflict        => '%s: cannot modify, value is inherited',
+    e_sys_config_inherit         => '%s: cannot inherit from an incomplete make',
+    e_sys_config_modifier        => '%s: incorrect modifier in declaration',
+    e_sys_config_ns              => '%s: incorrect name-space declaration',
+    e_sys_config_ns_value        => '%s: mismatch between name-space and value',
+    e_sys_config_unknown         => '%s: unknown declaration',
+    e_sys_config_value           => '%s: incorrect value in declaration',
+    e_sys_config_version         => '%s: requested version mismatch',
+    e_sys_copy                   => '%s -> %s: copy failed',
+    e_sys_dest_clean             => '%s: cannot remove',
+    e_sys_dest_create            => '%s: cannot create',
+    e_sys_dest_locked            => '%s: lock exists at the destination',
+    e_sys_export_items_src       => 'source location not specified',
+    e_sys_extract_loc_base       => '%s: cannot determine base location',
+    e_sys_extract_merge          => '%s: merge results in conflict',
+    e_sys_extract_merge_output   => '    merge output: %s',
+    e_sys_extract_merge_source   => '    source from location %2d: %s',
+    e_sys_extract_merge_source_0 => '(none)',
+    e_sys_extract_merge_source_x => '!!! source from location %2d: %s',
+    e_sys_extract_ns             => '%s: name-spaces declared but not used',
+    e_sys_mirror                 => '%s <- %s: mirror failed',
+    e_sys_mirror_null            => 'mirror target not specified',
+    e_sys_mirror_source          => '%s: cannot mirror this step',
+    e_sys_mirror_target          => '%s: cannot create mirror target',
+    e_sys_make                   => '%s: step is not implemented',
+    e_sys_make_arg               => 'arg %d (%s): invalid config declaration',
+    e_sys_make_arg_more          => 'did you mean "%s"?',
+    e_sys_make_cfg               => 'no configuration specified or found',
+    e_sys_make_cfg_file          => '%s: no such configuration file',
+    e_sys_make_prop_ns           => '%s.prop{%s}[%s] = %s: bad name-space',
+    e_sys_make_prop_value        => '%s.prop{%s}[%s] = %s: bad value',
+    e_sys_shell                  => '%s # rc=%d',
+    e_unknown                    => 'command failed',
+    e_util_class_loader          => '%s: required package cannot be loaded',
+    e_util_config                => '%s:%d: %s',
+    e_util_config_eof            => 'continuation at eof',
+    e_util_config_syntax         => 'syntax error',
+    e_util_config_usage          => 'incorrect usage',
+    e_util_config_var_undef      => 'reference to undefined variable',
+    e_util_config_stack_cyclic   => '%s: cannot load config file,'
+                                    . ' cyclic dependency',
+    e_util_config_stack_load     => '%s: cannot load config file',
+    e_util_io                    => '%s: I/O error',
+    e_util_locator               => '%s: not found',
+    e_util_locator_browser_url   => '%s: cannot determine browser URL',
+    e_util_locator_keyword_loc   => '%s: location keyword not defined',
+    e_util_locator_keyword_rev   => '%s: revision keyword not defined',
+    e_util_locator_reader        => '%s: cannot be read',
+    e_util_locator_type          => '%s: unsupported type of location',
+    e_util_shell_open3           => '%s: command failed to invoke',
+    e_util_shell_os              => '%s: command failed due to OS error',
+    e_util_shell_signal          => '%s: command received a signal',
+    e_util_shell_which           => '%s: command not found',
+
+    # NORMAL DIAGNOSTICS
+    cm_abort_null                => 'command will result in no change',
+    cm_abort_user                => 'by user',
+    cm_branch_create_source      => 'Source: %s (%d)',
+    cm_branch_list               => '%s: %d match(es)',
+    cm_commit_message            => 'Change summary:' . "\n"
+                                    . '-' x 80 . "\n" . '%s'
+                                    . '-' x 80 . "\n"
+                                    . 'Commit message is as follows:' . "\n"
+                                    . '-' x 80 . "\n" . '%s%s'
+                                    . '-' x 80,
+    cm_conflict_text             => '%s: in text conflict.',
+    cm_conflict_text_skip        => '%s: skipped binary file in text conflict.',
+    cm_conflict_tree             => '%s: in tree conflict.',
+    cm_conflict_tree_skip        => '%s: skipped unhandled tree conflict.',
+    cm_conflict_tree_time_warn   => '%s: looking for a rename operation,'
+                                    . ' please wait...',
+    cm_create_target             => 'Created: %s',
+    cm_log_edit                  => '%s: starting commit message editor...',
+    config_open                  => 'config-file=%s%s',
+    config_var_undef             => '%s:%d: %s: variable not defined',
+    event                        => '%s: event raised',
+    export_item_create           => 'A %s@%s -> %s',
+    export_item_delete           => 'D %s@%s -> %s',
+    fcm_version                  => '%s',
+    keyword_loc                  => 'location[%s] = %s',
+    keyword_loc_primary          => 'location{primary}[%s] = %s',
+    keyword_rev                  => 'revision[%s:%s] = %s',
+    make_build_shell_out_1       => '[>>&1] ',
+    make_build_shell_out_2       => '[>>&2] ',
+    make_build_source_analyse    => 'analyse %4.1f %s',
+    make_build_source_analyse_1  => '             -> (%9s) %s',
+    make_build_source_summary    => 'sources: total=%d, analysed=%d,'
+                                    . ' elapsed-time=%.1fs, total-time=%.1fs',
+    make_build_target_done_0     => '%-9s ---- %s %-20s <- %s',
+    make_build_target_done_1     => '%-9s %4.1f %s %-20s <- %s',
+    make_build_target_from_ns    => 'source->target %s -> (%s) %s/ %s',
+    make_build_target_select     => 'required-target: %-9s %-7s %s',
+    make_build_target_select_t   => 'target-tree-analysis: elapsed-time=%.1fs',
+    make_build_target_stack      => 'target %s%s%s',
+    make_build_target_stack_more => ' (n-deps=%d)',
+    make_build_target_missing_dep=> '%-30s: ignore-missing-dep: (%3$9s) %2$s',
+    make_build_target_sum        => 'TOTAL     targets:'
+                                    . ' modified=%d, unchanged=%d, failed=%d,'
+                                    . ' elapsed-time=%.1fs',
+    make_build_target_task_sum   => '%-9s targets:'
+                                    . ' modified=%d, unchanged=%d, failed=%d,'
+                                    . ' total-time=%.1fs',
+    make_build_targets_fail_0    => '! %-20s: depends on failed target: %s',
+    make_build_targets_fail_1    => '! %-20s: update task failed',
+    make_description             => 'description=%s',
+    make_dest                    => 'dest=%s',
+    make_dest_use                => 'use=%s',
+    make_extract_project_tree    => 'location %5s:%2d: %s%s',
+    make_extract_project_tree_1  => ' (%s)',
+    make_extract_runner_summary  => '%s: n-tasks=%d,'
+                                    . ' elapsed-time=%.1fs, total-time=%.1fs',
+    make_extract_target          => '%s%s %5s:%-6s %s',
+    make_extract_target_base_yes => '0',
+    make_extract_target_base_no  => '-',
+    make_extract_symlink         => 'symlink ignored: %s',
+    make_extract_target_summary_d=> '  dest: %4d [%1s %s]',
+    make_extract_target_summary_s=> 'source: %4d [%1s %s]',
+    make_mirror                  => '%s <- %s',
+    make_mode                    => 'mode=%s',
+    make_mode_new                => 'new',
+    make_mode_incr               => 'incremental',
+    shell                        => 'shell(%d %4.1f) %s',
+    task_workers_destroy         => '%s worker processes destroyed',
+    task_workers_init            => '%s worker processes started',
+    timer_done                   => '%-20s# %.1fs',
+    timer_init                   => '%-20s# %s',
+);
+# Symbols/Descriptions for a make extract target status.
+my %MAKE_EXTRACT_TARGET_SYM_OF = (
+    ST_ADDED     => ['A', 'added'                        ],
+    ST_DELETED   => ['D', 'deleted'                      ],
+    ST_MODIFIED  => ['M', 'modified'                     ],
+    ST_O_ADDED   => ['a', 'added, overriding inherited'  ],
+    ST_O_DELETED => ['d', 'deleted, overriding inherited'],
+    ST_UNCHANGED => ['U', 'unchanged'                    ],
+    ST_UNKNOWN   => ['?', 'unknown'                      ],
+);
+# Symbols/Descriptions for a make source status.
+my %MAKE_EXTRACT_SOURCE_SYM_OF = (
+    ST_ADDED     => ['A', 'added by a diff source tree'     ],
+    ST_DELETED   => ['D', 'deleted by a diff source tree'   ],
+    ST_MERGED    => ['G', 'merged from 2+ diff source trees'],
+    ST_MODIFIED  => ['M', 'modified by a diff source tree'  ],
+    ST_UNCHANGED => ['U', 'from base'                       ],
+    ST_UNKNOWN   => ['?', 'unknown'                         ],
+);
+
+# Creates the class.
+__PACKAGE__->class({util => '&'}, {action_of => {main => \&_main}});
+
+sub _main {
+    my ($attrib_ref, $event) = @_;
+    local($R) = $attrib_ref->{util}->util_of_report();
+    if (!exists($ACTION_OF{$event->get_code()})) {
+        return $R->report(
+            {level => $R->HIGH}, sprintf($S{event}, $event->get_code()),
+        );
+    }
+    $ACTION_OF{$event->get_code()}->(@{$event->get_args()});
+}
+
+# Formats a stack of configuration files.
+sub _format_config_stack {
+    my ($config_stack_ref) = @_;
+    my @config_stack = @{$config_stack_ref};
+    my $indent_char = q{};
+    my $return = q{};
+    my $i = 0;
+    for my $item (@config_stack) {
+        my ($locator, $line) = @{$item};
+        my $indent = q{ - } x $i++;
+        $return .= sprintf(
+            $S{'config_open'} . "\n",
+            $indent, ($locator->get_value() . ($line ? ':' . $line : q{})),
+        );
+    }
+    return $return;
+}
+
+# Formats a CM exception.
+sub _format_e_cm {
+    my ($e) = @_;
+    sprintf($E_CM_FORMAT_FOR{$e->get_code()}, $e->get_targets());
+}
+
+# Formats a class exception.
+sub _format_e_class {
+    my ($e) = @_;
+    sprintf(
+        $S{e_class},
+        $e->get_package(),
+        $e->get_key(),
+        (defined($e->get_value()) ? $e->get_value() : 'undef'),
+        @{$e->get_caller()}[1, 2],
+    );
+}
+
+# Formats a CLI exception.
+sub _format_e_cli {
+    my ($e) = @_;
+    my $format
+        = $e->get_code() eq $e->APP ? $S{e_cli_app}
+        :                             $S{e_cli_opt}
+        ;
+    sprintf($format, $e->get_ctx()->[0], basename($0));
+}
+
+# Formats a system exception.
+sub _format_e_sys {
+    my ($e) = @_;
+    if (exists($E_SYS_FORMATTER_FOR{$e->get_code()})) {
+        return $E_SYS_FORMATTER_FOR{$e->get_code()}->($e);
+    }
+    $e;
+}
+
+# Formats a system exception - CONFIG_*.
+sub _format_e_sys_config_func {
+    my ($suffix) = @_;
+    my $key = 'e_sys_config_' . $suffix;
+    sub {
+        my ($e) = @_;
+        my @ctx_list
+            = ref($e->get_ctx()) eq 'ARRAY' ? @{$e->get_ctx()}
+            :                                 ($e->get_ctx())
+            ;
+        map {(
+            sprintf($S{$key}, $_->as_string()),
+            _format_config_stack($_->get_stack()),
+        )} @ctx_list;
+    }
+}
+
+# Formats a system exception - BUILD_TARGET.
+sub _format_e_sys_build_target {
+    my ($e) = @_;
+    my $ctx = $e->get_ctx();
+    (   sprintf($S{e_sys_build_target}, $ctx->get_key()),
+        sprintf($S{e_sys_build_target_1}, $ctx->get_path()),
+    );
+}
+
+# Formats a system exception - BUILD_TARGET_CYC.
+sub _format_e_sys_build_target_cyc {
+    my ($e) = @_;
+    my @messages;
+    while (my ($key, $hash_ref) = each(%{$e->get_ctx()})) {
+        my ($head, @stack) = reverse(@{$hash_ref->{'keys'}});
+        push(@messages, sprintf($S{e_sys_build_target_cyclic}, $head));
+        push(@messages, map {sprintf($S{e_sys_build_target_stack}, $_)} @stack);
+    }
+    @messages;
+}
+
+# Formats a system exception - BUILD_TARGET_DEP.
+sub _format_e_sys_build_target_dep {
+    my ($e) = @_;
+    my @messages;
+    while (my ($key, $hash_ref) = each(%{$e->get_ctx()})) {
+        my ($head, @stack) = reverse(@{$hash_ref->{'keys'}});
+        for (@{$hash_ref->{'values'}}) { # [$dep_key, $dep_type]
+            my ($dep_name, $dep_type, $dep_remark) = @{$_};
+            if ($dep_remark) {
+                $dep_type = $dep_remark . '.' . $dep_type;
+            }
+            push(
+                @messages,
+                sprintf($S{e_sys_build_target_dep}, $dep_name, $dep_type),
+            );
+        }
+        push(@messages, map {sprintf($S{e_sys_build_target_stack}, $_)} @stack);
+    }
+    @messages;
+}
+
+# Formats a system exception - BUILD_TARGET_DUP.
+sub _format_e_sys_build_target_dup {
+    my ($e) = @_;
+    my @messages;
+    while (my ($key, $hash_ref) = each(%{$e->get_ctx()})) {
+        my ($head, @stack) = reverse(@{$hash_ref->{'keys'}});
+        my @ns_list = @{$hash_ref->{'values'}};
+        my $ns = _format_shell_words({'delimiter' => q{, }}, sort(@ns_list));
+        push(@messages, sprintf($S{e_sys_build_target_dup}, $key, $ns));
+        push(@messages, map {sprintf($S{e_sys_build_target_stack}, $_)} @stack);
+    }
+    @messages;
+}
+
+# Formats a system exception - EXTRACT_MERGE.
+sub _format_e_sys_extract_merge {
+    my ($e) = @_;
+    my $target = $e->get_ctx()->{'target'};
+    my $source0 = $target->get_source_of()->{0};
+    my $location_of_0 = $S{e_sys_extract_merge_source_0};
+    if ($source0->get_locator()) {
+        $location_of_0 = $source0->get_locator()->get_value();
+    }
+    my $key = $e->get_ctx()->{'key'};
+    my $location_of_key
+        = $target->get_source_of()->{$key}->get_locator()->get_value();
+    (   sprintf($S{e_sys_extract_merge}, $target->get_ns()),
+        sprintf($S{e_sys_extract_merge_output}, $e->get_ctx()->{'output'}),
+        sprintf($S{e_sys_extract_merge_source}, 0, $location_of_0),
+        (   map {sprintf(
+                $S{e_sys_extract_merge_source},
+                $_,
+                $target->get_source_of()->{$_}->get_locator()->get_value(),
+            )} @{$e->get_ctx()->{'keys_done'}}
+        ),
+        sprintf($S{e_sys_extract_merge_source_x}, $key, $location_of_key),
+        (   map {sprintf(
+                $S{e_sys_extract_merge_source},
+                $_,
+                $target->get_source_of()->{$_}->get_locator()->get_value(),
+            )} @{$e->get_ctx()->{'keys_left'}}
+        ),
+    );
+}
+
+# Formats a system exception - MIRROR.
+sub _format_e_sys_mirror {
+    my ($e) = @_;
+    my ($target, @sources) = @{$e->get_ctx()};
+    sprintf($S{e_sys_mirror}, $target, _format_shell_words(@sources));
+}
+
+# Formats a system exception - MAKE_ARG
+sub _format_e_sys_make_arg {
+    my ($e) = @_;
+    my @return;
+    for (@{$e->get_ctx()}) {
+        my ($arg_index, $arg_value) = @{$_};
+        push(@return, sprintf($S{e_sys_make_arg}, $arg_index, $arg_value));
+        my $advice
+            = $arg_value =~ qr{\.cfg\z}msx ? '-f ' . $arg_value
+            : $arg_value eq '0'            ? '-q'
+            : $arg_value eq '2'            ? '-v'
+            : $arg_value eq '3'            ? '-v -v'
+            :                                undef;
+        if (defined($advice)) {
+            push(@return, sprintf($S{e_sys_make_arg_more}, $advice));
+        }
+    }
+    return @return;
+}
+
+# Formats a system exception - MAKE_PROP_NS
+sub _format_e_sys_make_prop_ns {
+    my ($e) = @_;
+    map {sprintf($S{e_sys_make_prop_ns}, @{$_})} @{$e->get_ctx()};
+}
+
+# Formats a system exception - MAKE_PROP_VALUE
+sub _format_e_sys_make_prop_value {
+    my ($e) = @_;
+    map {sprintf($S{e_sys_make_prop_value}, @{$_})} @{$e->get_ctx()};
+}
+
+# Formats a system exception - SHELL.
+sub _format_e_sys_shell {
+    my ($e) = @_;
+    my $command = _format_shell_words(@{$e->get_ctx()->{command_list}});
+    my %value_of = (out => q{}, rc => '?', %{$e->get_ctx()});
+    return (
+        #(map {sprintf($S{e_sys_shell_err}, $_)} split("\n", $value_of{err})),
+        #(map {sprintf($S{e_sys_shell_out}, $_)} split("\n", $value_of{out})),
+        sprintf($S{e_sys_shell}, $command, $value_of{rc}),
+    );
+}
+
+# Formats a util exception.
+sub _format_e_util {
+    my ($e) = @_;
+    if (exists($E_UTIL_FORMATTER_FOR{$e->get_code()})) {
+        return $E_UTIL_FORMATTER_FOR{$e->get_code()}->($e);
+    }
+    $e;
+}
+
+# Returns a CODE to format a util config-reader exception.
+sub _format_e_util_config_func {
+    my ($id) = @_;
+    sub {
+        my ($e) = @_;
+        (   sprintf(
+                $S{'e_util_config'},
+                $e->get_ctx()->get_stack()->[-1][0]->get_value(),
+                $e->get_ctx()->get_stack()->[-1][1],
+                $S{'e_util_config_' . $id},
+            ),
+            $e->get_ctx()->as_string(),
+        );
+    };
+}
+
+# Returns a CODE to format a util config-reader exception where the ctx is the
+# locator stack.
+sub _format_e_util_config_stack_func {
+    my ($id) = @_;
+    sub {
+        my ($e) = @_;
+        my @return = (
+            _format_config_stack($e->get_ctx()),
+            sprintf(
+                $S{'e_util_config_stack_' . $id},
+                $e->get_ctx()->[-1][0]->get_value(),
+            ),
+        );
+        @return;
+    };
+}
+
+# Formats a locator exception.
+sub _format_e_util_locator_func {
+    my ($id) = @_;
+    sub {sprintf($S{'e_util_locator' . $id}, $_[0]->get_ctx()->get_value())};
+}
+
+# Formats a shell exception.
+sub _format_e_util_shell_func {
+    my ($id) = @_;
+    sub {
+        sprintf(
+            $S{'e_util_shell' . $id},
+            _format_shell_words(@{$_[0]->get_ctx()})
+        );
+    };
+}
+
+# Returns a CODE to format a exception context in a single/multi line.
+sub _format_e_func {
+    my ($id, $is_multi_line) = @_;
+    sub {
+        my ($e) = @_;
+        my @args;
+        if (defined($e->get_ctx())) {
+            @args = (ref($e->get_ctx()) || ref($e->get_ctx()) eq 'ARRAY')
+                ? @{$e->get_ctx()} : $e->get_ctx();
+        }
+        $is_multi_line
+            ? (map {sprintf($S{$id}, $_)} @args) : (sprintf($S{$id}, @args));
+    };
+}
+
+# Formats a simple reference.
+sub _format_ref {
+    my ($hash_ref) = @_;
+    local($Data::Dumper::Terse) = 1;
+    local($Data::Dumper::Indent) = 0;
+    Dumper($hash_ref);
+}
+
+# Formats words into a string suitable for used in a shell command.
+sub _format_shell_words {
+    my %option = ('delimiter' => q{ });
+    if (@_ && ref($_[0]) && ref($_[0]) eq 'HASH') {
+        %option = (%option, %{$_[0]});
+        shift();
+    }
+    my (@words) = @_;
+    join(
+        $option{'delimiter'},
+        map {my $s = $_; $s =~ s{(['"\s])}{\\$1}gmsx; $s} @words,
+    );
+}
+
+# Notification on abort of a CM command.
+sub _event_cm_abort {
+    my ($id) = @_;
+    $R->report(
+        {level => $R->QUIET, prefix => $R->PREFIX_QUIT, type => $R->TYPE_ERR},
+        $S{'cm_abort_' . $id},
+    );
+}
+
+# Notification on a project branch listing.
+sub _event_cm_branch_list {
+    my ($project, @branches) = @_;
+    $R->report(sprintf($S{'cm_branch_list'}, $project, scalar(@branches)));
+    for my $branch (@branches) {
+        $R->report({level => $R->QUIET, prefix => $R->PREFIX_NULL}, $branch);
+    }
+}
+
+# Notification on a log message to be used by a commit.
+sub _event_cm_commit_message {
+    my ($ctx) = @_;
+    $R->report(
+        {prefix => $R->PREFIX_NULL},
+        sprintf(
+            $S{'cm_commit_message'},
+            $ctx->get_info_part(), $ctx->get_user_part(), $ctx->get_auto_part(),
+        ),
+    );
+}
+
+# Notification on a skipped file in text conflict.
+sub _event_cm_conflict_text_skip {
+    my ($ctx) = @_;
+    $R->report({type => $R->TYPE_ERR}, sprintf($S{'cm_conflict_text_skip'}, $ctx));
+}
+
+# Notification for an unhandled type of tree conflict.
+sub _event_cm_conflict_tree_skip {
+    my ($ctx) = @_;
+    $R->report({type => $R->TYPE_ERR}, sprintf($S{'cm_conflict_tree_skip'}, $ctx));
+}
+
+# Warning that the tree conflict operation search may take some time.
+sub _event_cm_conflict_tree_time_warn {
+    my ($ctx) = @_;
+    $R->report({type => $R->TYPE_ERR}, sprintf($S{'cm_conflict_tree_time_warn'}, $ctx));
+}
+
+# Notification when a config entry is found.
+sub _event_config_entry {
+    my ($entry, $in_fcm1) = @_;
+    $R->report(
+        {level => $R->QUIET, prefix => $R->PREFIX_NULL},
+        $entry->as_string($in_fcm1),
+    );
+}
+
+# Notification for a configuration file open.
+sub _event_config_open {
+    my ($config_stack_ref, $level) = @_;
+    $R->report(
+        {level => (defined($level) ? $level : $R->DEBUG)},
+        sub {
+            my $value = $config_stack_ref->[-1][0]->get_value();
+            my $indent = q{ - } x (scalar(@{$config_stack_ref}) - 1);
+            sprintf($S{config_open}, $indent, $value);
+        },
+    );
+}
+
+# Notification when a config variable is undefined.
+sub _event_config_var_undef {
+    my ($entry, $symbol) = @_;
+    $R->report(
+        {type => $R->TYPE_ERR},
+        sprintf(
+            $S{'config_var_undef'},
+            $entry->get_stack()->[-1][0]->get_value(),
+            $entry->get_stack()->[-1][1],
+            $symbol,
+        ),
+    );
+}
+
+# Notification for an exception.
+sub _event_e {
+    my ($exception) = @_;
+    my @e_stack = ($exception);
+    while ( blessed($e_stack[-1])
+        &&  $e_stack[-1]->can('get_exception')
+        &&  (my $e = $e_stack[-1]->get_exception())
+    ) {
+        push(@e_stack, $e);
+    }
+    while (my $e = shift(@e_stack)) {
+        my $formatter;
+        if (blessed($e)) {
+            my $item = first {$e->isa($_->[0])} @E_FORMATTERS;
+            if ($item) {
+                $formatter = $item->[1];
+            }
+            if (!$formatter && $e->can('as_string')) {
+                $formatter = sub {$e->as_string()};
+            }
+        }
+        elsif (ref($e)) {
+            $formatter = \&_format_ref;
+        }
+        elsif ($e eq "\n") {
+            chomp($e);
+        }
+        $R->report(
+            {level => $R->FAIL, type => $R->TYPE_ERR},
+            (defined($formatter) ? $formatter->($e) : $e),
+        );
+    }
+    1;
+}
+
+# Notification when a keyword entry is found.
+sub _event_keyword_entry {
+    my ($entry) = @_;
+    if ($entry->is_implied()) {
+        return;
+    }
+    my @implied_entry_list
+        = values(%{$entry->get_ctx_of_implied()->get_entry_by_key()});
+    if (@implied_entry_list) {
+        $R->report(
+            {level => $R->QUIET, prefix => $R->PREFIX_NULL},
+            sprintf(
+                $S{keyword_loc_primary},
+                $entry->get_key(),
+                $entry->get_value(),
+            ),
+        );
+        for my $implied_entry (
+            sort {$a->get_key() cmp $b->get_key()} @implied_entry_list
+        ) {
+            $R->report(
+                {level => $R->MEDIUM, prefix => $R->PREFIX_NULL},
+                sprintf(
+                    $S{keyword_loc},
+                    $implied_entry->get_key(),
+                    $implied_entry->get_value(),
+                ),
+            );
+        }
+    }
+    else {
+        $R->report(
+            {level => $R->QUIET, prefix => $R->PREFIX_NULL},
+            sprintf($S{keyword_loc}, $entry->get_key(), $entry->get_value()),
+        );
+    }
+    my @revision_entry_list
+        = values(%{$entry->get_ctx_of_rev()->get_entry_by_key()});
+    for my $revision_entry (
+        sort {$a->get_key() cmp $b->get_key()} @revision_entry_list
+    ) {
+        $R->report(
+            {level => $R->QUIET, prefix => $R->PREFIX_NULL},
+            sprintf(
+                $S{keyword_rev},
+                $entry->get_key(),
+                $revision_entry->get_key(),
+                $revision_entry->get_value(),
+            ),
+        );
+    }
+    1;
+}
+
+# Notification of the output from a command.
+sub _event_out {
+    my ($out, $err) = @_;
+    my %option = (delimiter => q{}, prefix => $R->PREFIX_NULL);
+    if ($err) {
+        $R->report({level => $R->WARN, type => $R->TYPE_ERR, %option}, $err);
+    }
+    if ($out) {
+        $R->report({level => $R->QUIET, %option}, $out);
+    }
+}
+
+# Notification of the output from a command invoked by make/build.
+sub _event_make_build_shell_out {
+    my ($out, $err) = @_;
+    if ($err) {
+        $R->report(
+            {   level => $R->HIGH,
+                prefix => $S{'make_build_shell_out_2'},
+                type => $R->TYPE_ERR,
+            },
+            $err,
+        );
+    }
+    if ($out) {
+        $R->report(
+            {level => $R->HIGH, prefix => $S{'make_build_shell_out_1'}},
+            $out,
+        );
+    }
+}
+
+# Notification when a make destination is being set up.
+sub _event_make_dest {
+    my ($m_ctx, $authority) = @_;
+    if ($m_ctx->get_description()) {
+        $R->report(sprintf($S{make_description}, $m_ctx->get_description()));
+    }
+    $R->report(sprintf($S{make_dest}, $authority . ':' . $m_ctx->get_dest()));
+    $R->report(sprintf(
+        $S{make_mode},
+        $S{'make_mode_' . ($m_ctx->get_prev_ctx() ? 'incr' : 'new')},
+    ));
+    for my $i_ctx (@{$m_ctx->get_inherit_ctx_list()}) {
+        $R->report(sprintf($S{make_dest_use}, $i_ctx->get_dest()));
+    }
+}
+
+# Notification when performing a mirroring.
+sub _event_make_mirror {
+    my ($target, @sources) = @_;
+    $R->report(sprintf($S{make_mirror}, $target, _format_shell_words(@sources)));
+}
+
+# Notification when the multi-thread task runner initiates its workers.
+sub _event_task_workers {
+    my ($id, $n_workers) = @_;
+    my $key = 'task_workers_' . $id;
+    if (exists($S{$key})) {
+        $R->report({level => $R->HIGH}, sprintf($S{$key}, $n_workers));
+    }
+}
+
+# Notification when invoking a shell command.
+sub _event_shell {
+    my ($names_ref, $rc, $elapsed) = @_;
+    my $name = _format_shell_words(@{$names_ref});
+    my $message = sprintf($S{shell}, $rc, $elapsed, $name);
+    $R->report({level => $R->HIGH}, $message);
+}
+
+# Notification when a timer starts/ends.
+sub _event_timer {
+    my ($name, $start, $elapsed, $failed) = @_;
+    my $message;
+    if (defined($elapsed)) {
+        $message = sprintf($S{timer_done}, $name, $elapsed);
+    }
+    else {
+        my $format = '%Y-%m-%dT%H:%M:%SZ';
+        $message = sprintf(
+            $S{timer_init}, $name, strftime($format, gmtime($start)));
+    }
+    my $prefix
+        = $failed           ? $R->PREFIX_FAIL
+        : defined($elapsed) ? $R->PREFIX_DONE
+        :                     $R->PREFIX_INIT
+        ;
+    $R->report({prefix => $prefix}, $message);
+}
+
+# Notification when make-build analyse a source.
+sub _event_make_build_source_analyse {
+    my ($source, $elapse) = @_;
+    $R->report(
+        {level => $R->MEDIUM},
+        sprintf($S{make_build_source_analyse}, $elapse, $source->get_ns()),
+    );
+    for my $dep (@{$source->get_deps()}) {
+        $R->report(
+            {level => $R->HIGH},
+            sprintf($S{make_build_source_analyse_1}, reverse(@{$dep})),
+        );
+    }
+}
+
+# Notification when make-build has updated or does not need to update a target.
+sub _event_make_build_target_done {
+    my ($target, $elapsed_time) = @_;
+    my $tmpl = defined($elapsed_time)
+        ? $S{make_build_target_done_1} : $S{make_build_target_done_0};
+    $R->report(
+        {level => $R->MEDIUM},
+        sprintf(
+            $tmpl,
+            $target->get_task(),
+            (defined($elapsed_time) ? ($elapsed_time) : ()),
+            $MAKE_EXTRACT_TARGET_SYM_OF{$target->get_status()}[0],
+            $target->get_key(),
+            $target->get_ns(),
+        ),
+    );
+}
+
+# Notification when make-build a target fails to update or is failed by
+# dependencies.
+sub _event_make_build_target_fail {
+    my ($target, $elapsed_time) = @_;
+    my $tmpl = defined($elapsed_time)
+        ? $S{make_build_target_done_1} : $S{make_build_target_done_0};
+    $R->report(
+        {level => $R->FAIL, type => $R->TYPE_ERR},
+        sprintf(
+            $tmpl,
+            $target->get_task(),
+            (defined($elapsed_time) ? ($elapsed_time) : ()),
+            '!',
+            $target->get_key(),
+            $target->get_ns(),
+        ),
+    );
+}
+
+# Notification when make-build ignores a missing dependency from a target.
+sub _event_make_build_target_missing_dep {
+    $R->report(
+        {level => $R->WARN, type => $R->TYPE_ERR},
+        sprintf($S{make_build_target_missing_dep}, @_),
+    );
+}
+
+# Notification when make-build generates a target from source.
+sub _event_make_build_target_from_ns {
+    $R->report(
+        {level => $R->HIGH},
+        sprintf($S{make_build_target_from_ns}, @_),
+    );
+}
+
+# Notification when make-build chooses a list of targets to build.
+sub _event_make_build_target_select {
+    my ($target_set_ref) = @_;
+    $R->report(
+        {level => $R->HIGH},
+        sub {
+            map {
+                my $key = $_;
+                my $target = $target_set_ref->{$key};
+                sprintf(
+                    $S{make_build_target_select},
+                    $target->get_task(), $target->get_category(), $key,
+                );
+            }
+            sort keys(%{$target_set_ref});
+        },
+    );
+}
+
+# Notification when make-build checks a target for cyclic dependency.
+sub _event_make_build_target_stack {
+    my ($key, $rank, $n_deps) = @_;
+    $R->report(
+        {level => $R->HIGH},
+        sub {
+            my $indent = q{ - } x $rank;
+            my $more
+                = $n_deps ? sprintf($S{make_build_target_stack_more}, $n_deps)
+                :           q{}
+                ;
+            sprintf($S{make_build_target_stack}, $indent, $key, $more),
+        },
+    );
+}
+
+# Notification when make-build fails to update some targets.
+sub _event_make_build_targets_fail {
+    my ($targets_ref) = @_;
+    $R->report(
+        {type => $R->TYPE_ERR, level => $R->FAIL},
+        (map {
+            my $target = $_;
+            my @failed_by = @{$target->get_failed_by()};
+            my @lines;
+            if (grep {$_ eq $target->get_key()} @failed_by) {
+                push(
+                    @lines,
+                    sprintf($S{make_build_targets_fail_1}, $target->get_key()),
+                );
+            }
+            for my $failed_by_key (grep {$_ ne $target->get_key()} @failed_by) {
+                push(
+                    @lines,
+                    sprintf(
+                        $S{make_build_targets_fail_0},
+                        $target->get_key(),
+                        $failed_by_key,
+                    ),
+                );
+            }
+            @lines;
+        } sort {$a->get_key() cmp $b->get_key()} @{$targets_ref}),
+    );
+}
+
+# Notification when make-extract finished gathering information for its project
+# source trees.
+sub _event_make_extract_project_tree {
+    my %locators_of = %{$_[0]};
+    for my $ns (sort(keys(%locators_of))) {
+        my $i = 0;
+        for my $locator (@{$locators_of{$ns}}) {
+            my $format_last_mod_rev = q{};
+            if ($locator->get_last_mod_rev()) {
+                $format_last_mod_rev = sprintf(
+                    $S{'make_extract_project_tree_1'},
+                    $locator->get_last_mod_rev(),
+                );
+            }
+            $R->report(
+                sprintf(
+                    $S{'make_extract_project_tree'},
+                    $ns, $i++, $locator->get_value(), $format_last_mod_rev
+                ),
+            );
+        }
+    }
+}
+
+# Notification when make-extract used the task runner to perform tasks.
+sub _event_make_extract_runner_summary {
+    $R->report(
+        {level => $R->HIGH},
+        sprintf($S{'make_extract_runner_summary'}, @_),
+    );
+}
+
+# Notification when make-extract completes updating its targets.
+sub _event_make_extract_target_summary {
+    my ($basket) = @_;
+    for (
+        [   'status',
+            'make_extract_target_summary_d',
+            \%MAKE_EXTRACT_TARGET_SYM_OF,
+        ],
+        [   'status_of_source',
+            'make_extract_target_summary_s',
+            \%MAKE_EXTRACT_SOURCE_SYM_OF,
+        ],
+    ) {
+        my ($name, $format_name, $sym_hash_ref) = @{$_};
+        for my $key (sort keys(%{$basket->{$name}})) {
+            $R->report(sprintf(
+                $S{$format_name},
+                $basket->{$name}{$key},
+                $sym_hash_ref->{$key}[0],
+                $sym_hash_ref->{$key}[1],
+            ));
+        }
+    }
+}
+
+# Notification when make-extract ignores a symlink.
+sub _event_make_extract_symlink {
+    my ($source) = @_;
+    $R->report(
+        {type => $R->TYPE_ERR},
+        sprintf($S{make_extract_symlink}, $source->get_locator()->get_value()),
+    );
+}
+
+# Notification when make-extract updates a target.
+sub _event_make_extract_target {
+    my ($target) = @_;
+    if (!exists($MAKE_EXTRACT_TARGET_SYM_OF{$target->get_status()})) {
+        return;
+    }
+    $R->report(
+        {level => $R->MEDIUM},
+        sub {
+            my ($verbosity) = @_;
+            if ($verbosity < $R->DEBUG && $target->is_unchanged()) {
+                return;
+            }
+            my ($ns, $path) = split(qr{/}msx, $target->get_ns(), 2);
+            my %source_of = %{$target->get_source_of()};
+            my $base = delete($source_of{0});
+            my @diff_keys
+                = grep {!$source_of{$_}->is_unchanged()} keys(%source_of);
+            my @st_missing_diff_keys
+                = grep {$source_of{$_}->is_missing()} @diff_keys;
+            if (@st_missing_diff_keys) {
+                @diff_keys = @st_missing_diff_keys;
+            }
+            sprintf(
+                $S{make_extract_target},
+                $MAKE_EXTRACT_TARGET_SYM_OF{$target->get_status()}[0],
+                $MAKE_EXTRACT_SOURCE_SYM_OF{$target->get_status_of_source()}[0],
+                $ns,
+                join(
+                q{,},
+                    (   defined($base) && defined($base->get_locator())
+                            ? ($S{make_extract_target_base_yes})
+                            : ($S{make_extract_target_base_no})
+                    ),
+                    sort({$a <=> $b} @diff_keys),
+                ),
+                $path,
+            );
+        },
+    );
+}
+
+# Returns a CODE to perform a simple notification with sprintf format.
+sub _func {
+    my ($id) = @_;
+    sub {$R->report(sprintf($S{$id}, @_))};
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Util::Event
+
+=head1 SYNOPSIS
+
+    use FCM::Util::Event;
+    $event_handler = FCM::Util::Event->new(\%attrib);
+    $event_handler->($event);
+
+=head1 DESCRIPTION
+
+Handles events wrapped as L<FCM::Context::Event|FCM::Context::Event> objects by
+stringifying and reporting them.
+
+This module is part of L<FCM::Util|FCM::Util>. See also the description of the
+$u->report() method in L<FCM::Util|FCM::Util>.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Returns a new instance. The %attrib HASH can have the following elements:
+
+=over 4
+
+=item util
+
+The parent L<FCM::Util|FCM::Util> object.
+
+=back
+
+=item $util->event($event_ctx)
+
+Notification of an $event_ctx, which should be a blessed reference of
+L<FCM::Context::Event|FCM::Context::Event>.
+
+=back
+
+=head1 TODO
+
+Modularise?
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Exception.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Exception.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Exception.pm	(revision 5095)
@@ -0,0 +1,219 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+
+package FCM::Util::Exception;
+use base qw{FCM::Exception};
+
+use constant {
+    CLASS_LOADER         => 'CLASS_LOADER',
+    CONFIG_CONT_EOF      => 'CONFIG_CONT_EOF',
+    CONFIG_CYCLIC        => 'CONFIG_CYCLIC',
+    CONFIG_LOAD          => 'CONFIG_LOAD',
+    CONFIG_SYNTAX        => 'CONFIG_SYNTAX',
+    CONFIG_USAGE         => 'CONFIG_USAGE',
+    CONFIG_VAR_UNDEF     => 'CONFIG_VAR_UNDEF',
+    IO                   => 'IO',
+    LOCATOR_AS_INVARIANT => 'LOCATOR_AS_INVARIANT',
+    LOCATOR_BROWSER_URL  => 'LOCATOR_BROWSER_URL',
+    LOCATOR_FIND         => 'LOCATOR_FIND',
+    LOCATOR_KEYWORD_LOC  => 'LOCATOR_KEYWORD_LOC',
+    LOCATOR_KEYWORD_REV  => 'LOCATOR_KEYWORD_REV',
+    LOCATOR_READER       => 'LOCATOR_READER',
+    LOCATOR_TYPE         => 'LOCATOR_TYPE',
+    SHELL_OPEN3          => 'SHELL_OPEN3',
+    SHELL_OS             => 'SHELL_OS',
+    SHELL_SIGNAL         => 'SHELL_SIGNAL',
+    SHELL_WHICH          => 'SHELL_WHICH',
+};
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Util::Exception
+
+=head1 SYNOPSIS
+
+    use FCM::Util::Exception;
+    eval {
+        # something does not work ...
+        FCM::Util::Exception->throw($code, $ctx, $exception);
+    };
+    if (my $e = $@) {
+        if (FCM::Util::Exception->caught($e)) {
+            # do something ...
+        }
+        else {
+            # do something else ...
+        }
+    }
+
+=head1 DESCRIPTION
+
+This exception represents an error condition in an FCM utility. It is a
+sub-class of L<FCM::Exception|FCM::Exception>.
+
+=head1 CONSTANTS
+
+The following are known error code:
+
+=over 4
+
+=item CLASS_LOADER
+
+L<FCM::Util::ClassLoader|FCM::Util::ClassLoader>: The utility fails to load the
+specified class. The $e->get_ctx() method returns the name of the class it fails
+to load.
+
+=item CONFIG_CONT_EOF
+
+L<FCM::Util::ConfigReader|FCM::Util::ConfigReader>: The last line of the
+configuration file has a continuation marker. Expects the $e->get_ctx() method
+to return the L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry> object that
+represents the problem entry.
+
+=item CONFIG_CYCLIC
+
+L<FCM::Util::ConfigReader|FCM::Util::ConfigReader>: There is a cyclic dependency
+in the include hierarchy. Expects the $e->get_ctx() method to return an ARRAY
+reference of the locator stack. (The last element of the ARRAY is the top of the
+stack, and each element is a 2-element ARRAY reference, where the first element
+is a L<FCM::Context::Locator|FCM::Context::Locator> object and the second
+element is the line number.)
+
+=item CONFIG_LOAD
+
+L<FCM::Util::ConfigReader|FCM::Util::ConfigReader>: An error occurs when loading
+a configuration file. Expects the $e->get_ctx() method to return an ARRAY
+reference of the locator stack. (The last element of the ARRAY is the top of the
+stack, and each element is a 2-element ARRAY reference, where the first element
+is a L<FCM::Context::Locator|FCM::Context::Locator> object and the second
+element is the line number.)
+
+=item CONFIG_SYNTAX
+
+L<FCM::Util::ConfigReader|FCM::Util::ConfigReader>: A syntax error in the
+declaration. Expects the $e->get_ctx() method to return the
+L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry> object that represents
+the problem entry.
+
+=item CONFIG_USAGE
+
+L<FCM::Util::ConfigReader|FCM::Util::ConfigReader>: An attempt to assign a value
+to a reserved variable. Expects the $e->get_ctx() method to return the
+L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry> object that represents
+the problem entry.
+
+=item CONFIG_VAR_UNDEF
+
+L<FCM::Util::ConfigReader|FCM::Util::ConfigReader>: References to an undefined
+variable. Expects the $e->get_ctx() method to return the
+L<FCM::Context::ConfigEntry|FCM::Context::ConfigEntry> object that represents
+the problem entry, and $e->get_exception() to return a string that looks like
+"undef($symbol)" where $symbol is the symbol that references the variable.
+
+=item IO
+
+L<FCM::Util::IO|FCM::Util::IO>: I/O exception. Expects $e->get_ctx() to return
+the path that triggers the exception, and the $e->get_exception() to return the
+$! string.
+
+=item LOCATOR_AS_INVARIANT
+
+L<FCM::Util::Locator|FCM::Util::Locator>: The invariant value of the locator
+cannot be determined. Expects $e->get_ctx() method to return the associated
+L<FCM::Context::Locator|FCM::Context::Locator> object.
+
+=item LOCATOR_BROWSER_URL
+
+L<FCM::Util::Locator|FCM::Util::Locator>: The locator cannot be mapped to a
+browser URL. Expects $e->get_ctx() method to return the associated
+L<FCM::Context::Locator|FCM::Context::Locator> object.
+
+=item LOCATOR_FIND
+
+L<FCM::Util::Locator|FCM::Util::Locator>: The locator does not exist. Expects
+$e->get_ctx() method to return the associated
+L<FCM::Context::Locator|FCM::Context::Locator> object.
+
+=item LOCATOR_KEYWORD_LOC
+
+L<FCM::Util::Locator|FCM::Util::Locator>: The location keyword as specified in
+the locator is not defined. Expects $e->get_ctx() method to return the
+associated L<FCM::Context::Locator|FCM::Context::Locator> object.
+
+=item LOCATOR_KEYWORD_REV
+
+L<FCM::Util::Locator|FCM::Util::Locator>: The revision keyword as specified in
+the locator is not defined. Expects $e->get_ctx() method to return the
+associated L<FCM::Context::Locator|FCM::Context::Locator> object.
+
+=item LOCATOR_READER
+
+L<FCM::Util::Locator|FCM::Util::Locator>: The locator cannot be read. Expects
+$e->get_ctx() method to return the associated
+L<FCM::Context::Locator|FCM::Context::Locator> object.
+
+=item LOCATOR_TYPE
+
+L<FCM::Util::Locator|FCM::Util::Locator>: The locator type cannot be determined
+or cannot be supported. Expects $e->get_ctx() method to return the associated
+L<FCM::Context::Locator|FCM::Context::Locator> object.
+
+=item LOCATOR_WHEN
+
+L<FCM::Util::Locator|FCM::Util::Locator>: The last modified date and revision of
+the locator cannot be determined. Expects $e->get_ctx() method to return the
+associated L<FCM::Context::Locator|FCM::Context::Locator> object.
+
+=item SHELL_OPEN3
+
+L<FCM::Util::Shell|FCM::Util::Shell>: The utility fails to invoke
+IPC::Open3::open3(). Expects $e->get_ctx() to return an ARRAY reference of the
+command line, and $e->get_exception() to return the error from open3().
+
+=item SHELL_OS
+
+L<FCM::Util::Shell|FCM::Util::Shell>: An OS error occurs when invoking a shell
+command. Expects $e->get_ctx() to return an ARRAY reference of the
+command line, and $e->get_exception() to return $!.
+
+=item SHELL_SIGNAL
+
+L<FCM::Util::Shell|FCM::Util::Shell>: The system receives a signal when invoking
+a shell command. Expects $e->get_ctx() to return an ARRAY reference of the
+command line, and $e->get_exception() to return the signal number.
+
+=item SHELL_WHICH
+
+L<FCM::Util::Shell|FCM::Util::Shell>: The shell command does not exist in the
+PATH. Expects $e->get_ctx() to return an ARRAY reference of the command line.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Locator.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Locator.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Locator.pm	(revision 5095)
@@ -0,0 +1,767 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Util::Locator;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::Keyword;
+use FCM::Context::Locator;
+use FCM::Util::Exception;
+use FCM::Util::Locator::FS;
+use FCM::Util::Locator::SSH;
+use FCM::Util::Locator::SVN;
+
+# URI prefix for FCM scheme
+use constant PREFIX => 'fcm';
+
+# Methods of an instance of this class
+my %ACTION_OF = (
+    as_invariant     => \&_as_invariant,
+    as_keyword       => \&_as_keyword,
+    as_normalised    => \&_as_normalised,
+    as_parsed        => \&_as_parsed,
+    browser_url      => \&_browser_url,
+    cat              => _locator_func(sub {$_[0]->cat(@_[1 .. $#_])}),
+    dir              => _locator_func(sub {$_[0]->dir($_[1])}),
+    export           => \&_export,
+    export_ok        => \&_export_ok,
+    find             => \&_find,
+    kw_ctx           => sub {$_[0]->{kw_ctx}},
+    kw_ctx_load      => \&_kw_ctx_load,
+    kw_iter          => \&_kw_iter,
+    kw_load_rev_prop => \&_kw_load_rev_prop,
+    kw_prefix        => sub {PREFIX},
+    origin           => _locator_func(sub {$_[0]->origin($_[1])}),
+    reader           => \&_reader,
+    rel2abs          => \&_rel2abs,
+    test_exists      => \&_test_exists,
+    trunk_at_head    => \&_trunk_at_head,
+    what_type        => \&_what_type,
+    up_iter          => \&_up_iter,
+);
+# Default browser config
+our %BROWSER_CONFIG = (
+    comp_pat => qr{\A // ([^/]+) /+ ([^/]+)_svn /*(.*) \z}xms,
+    rev_tmpl => '@{1}',
+    loc_tmpl => 'http://{1}/projects/{2}/intertrac/source:/{3}{4}',
+);
+# Alias to the exception class
+my $E = 'FCM::Util::Exception';
+# Loaders for keyword context from configuration entries
+my %KEYWORD_CFG_LOADER_FOR = (
+    'location'
+    => \&_kw_ctx_load_loc,
+    'revision'
+    => \&_kw_ctx_load_rev,
+    'browser.comp-pat'
+    => _kw_ctx_load_browser_func(sub {$_[0]->set_comp_pat($_[1])}),
+    'browser.loc-tmpl'
+    => _kw_ctx_load_browser_func(sub {$_[0]->set_loc_tmpl($_[1])}),
+    'browser.rev-tmpl'
+    => _kw_ctx_load_browser_func(sub {$_[0]->set_rev_tmpl($_[1])}),
+);
+my @KEYWORD_IMPLIED_SUFFICES = (
+    [branches => [qw{-br _br}]],
+    [tags     => [qw{-tg _tg}]],
+    [trunk    => [qw{-tr _tr}]],
+);
+# Patterns for parsing keyword configurations, etc
+my %PATTERN_OF = (
+    # Assignment delimiter, e.g. "label = value"
+    delim_of_assign  => qr/\s* = \s*/xms,
+    # Key of a FCM location keyword, e.g. "um" in "fcm:um"
+    parse => qr/
+        \A              (?# start)
+        ([\w\+\-\.]+)   (?# capture 1, 1 or more word, plus, minus or dot)
+        (.*) \z         (?# capture 2, rest of string)
+    /xms,
+);
+# The name of the property where revision keywords are set in primary locations
+our $REV_PROP_NAME = 'fcm:revision';
+# The known types
+our @TYPES = qw{svn ssh fs};
+# The classes for the known types
+our %TYPE_UTIL_CLASS_OF = (
+    fs  => 'FCM::Util::Locator::FS',
+    ssh => 'FCM::Util::Locator::SSH',
+    svn => 'FCM::Util::Locator::SVN',
+);
+
+# Creates the class.
+__PACKAGE__->class(
+    {   types              => {isa => '@', default => [@TYPES]},
+        type_util_class_of => {isa => '%', default => {%TYPE_UTIL_CLASS_OF}},
+        type_util_of       => '%',
+        util               => '&',
+    },
+    {   init => sub {
+            my ($attrib_ref) = @_;
+            my $K = 'FCM::Context::Keyword';
+            $attrib_ref->{browser_config}
+                = $K->BROWSER_CONFIG->new(\%BROWSER_CONFIG);
+            $attrib_ref->{kw_ctx} = $K->new();
+            for my $type (@{$attrib_ref->{types}}) {
+                if (!exists($attrib_ref->{type_util_of}{$type})) {
+                    my $class = $attrib_ref->{type_util_class_of}{$type};
+                    $attrib_ref->{type_util_of}{$type} = $class->new({
+                        type_util_of => $attrib_ref->{type_util_of},
+                        util         => $attrib_ref->{util},
+                    });
+                }
+            }
+        },
+        action_of => \%ACTION_OF,
+    },
+);
+
+# Determines the invariant value of the $locator.
+sub _as_invariant {
+    my ($attrib_ref, $locator) = @_;
+    if ($locator->get_value_level() < $locator->L_INVARIANT) {
+        _as_normalised($attrib_ref, $locator);
+        my $util_of_type = _util_of_type($attrib_ref, $locator);
+        if ($util_of_type->can('as_invariant')) {
+            my $value = eval {
+                $util_of_type->as_invariant($locator->get_value());
+            };
+            if (my $e = $@) {
+                return $E->throw($E->LOCATOR_AS_INVARIANT, $locator, $e);
+            }
+            if ($value) {
+                $locator->set_value($value);
+                $locator->set_value_level($locator->L_INVARIANT);
+            }
+        }
+    }
+    $locator->get_value();
+}
+
+# Determines the keyword value of the $locator.
+sub _as_keyword {
+    my ($attrib_ref, $locator) = @_;
+    _as_normalised($attrib_ref, $locator);
+    my $util_of_type = _util_of_type($attrib_ref, $locator);
+    my ($target, $rev) = $util_of_type->parse($locator->get_value());
+    my $kw_iter = _kw_iter($attrib_ref, $locator);
+    my $entry;
+    while (!defined($entry) && defined($entry = $kw_iter->())) {
+        if ($entry->is_implied()) {
+            $entry = undef;
+        }
+    }
+    if (defined($entry)) {
+        $target
+            = PREFIX . ':' . $entry->get_key()
+            . substr($target, length($entry->get_value()));
+    }
+    if (defined($rev) && $util_of_type->can_work_with_rev($rev)) {
+        my $transformed_rev = _transform_rev_keyword(
+            $attrib_ref, $locator, $rev,
+            sub {$_[0]->get_entry_by_value($_[1])},
+            sub {$_[0]->get_key()},
+        );
+        if ($transformed_rev) {
+            $rev = $transformed_rev;
+        }
+    }
+    scalar($util_of_type->parse($target, $rev));
+}
+
+# Determines the normalised value of the $locator.
+sub _as_normalised {
+    my ($attrib_ref, $locator) = @_;
+    if ($locator->get_value_level() < $locator->L_NORMALISED) {
+        _as_parsed($attrib_ref, $locator);
+        my $util_of_type = _util_of_type($attrib_ref, $locator);
+        my ($target, $rev) = $util_of_type->parse($locator->get_value());
+        if (defined($rev) && !$util_of_type->can_work_with_rev($rev)) {
+            my $origin = $ACTION_OF{origin}->(
+                $attrib_ref, FCM::Context::Locator->new($target),
+            );
+            $rev = _transform_rev_keyword(
+                $attrib_ref, $origin, lc($rev),
+                sub {$_[0]->get_entry_by_key($_[1])},
+                sub {$_[0]->get_value()},
+            );
+            if (!$rev) {
+                return $E->throw($E->LOCATOR_KEYWORD_REV, $locator);
+            }
+        }
+        $locator->set_value(scalar($util_of_type->parse($target, $rev)));
+        $locator->set_value_level($locator->L_NORMALISED);
+    }
+    $locator->get_value();
+}
+
+# Determines the parsed value of the $locator.
+sub _as_parsed {
+    my ($attrib_ref, $locator) = @_;
+    if ($locator->get_value_level() < $locator->L_PARSED) {
+        my $value = $locator->get_value();
+        my ($scheme, $sps) = $attrib_ref->{util}->uri_match($value);
+        if ($scheme && $scheme eq PREFIX) {
+            my ($key, $trail) = $sps =~ $PATTERN_OF{parse};
+            my $entry = $attrib_ref->{kw_ctx}->get_entry_by_key(lc($key));
+            if (!defined($entry)) {
+                return $E->throw($E->LOCATOR_KEYWORD_LOC, $locator);
+            }
+            $value = $entry->get_value() . $trail;
+        }
+        $locator->set_value($value);
+        $locator->set_value_level($locator->L_PARSED);
+    }
+    $locator->get_value();
+}
+
+# Determines the browser URL of the $locator.
+sub _browser_url {
+    my ($attrib_ref, $locator) = @_;
+    _as_normalised($attrib_ref, $locator);
+    my %GET = (
+        comp_pat => sub {$_[0]->get_comp_pat()},
+        loc_tmpl => sub {$_[0]->get_loc_tmpl()},
+        rev_tmpl => sub {$_[0]->get_rev_tmpl()},
+    );
+    my %value_of = map {($_, undef)} keys(%GET);
+    my $iter = _kw_iter($attrib_ref, $locator);
+    while (my $entry = $iter->()) {
+        if (defined($entry->get_browser_config())) {
+            for my $key (keys(%value_of)) {
+                if (!defined($value_of{$key})) {
+                    my $value = $GET{$key}->($entry->get_browser_config());
+                    if (defined($value)) {
+                        $value_of{$key} = $value;
+                    }
+                }
+            }
+        }
+    }
+    for my $key (keys(%value_of)) {
+        if (!$value_of{$key}) {
+            $value_of{$key} = $GET{$key}->($attrib_ref->{browser_config});
+        }
+    }
+    # Extracts components from the locator
+    my $origin = $ACTION_OF{origin}->($attrib_ref, $locator);
+    my ($target, $rev)
+        = _util_of_type($attrib_ref, $origin)->parse($origin->get_value());
+    my ($scheme, $sps) = $attrib_ref->{util}->uri_match($target);
+    if (!$sps) {
+        return $E->throw($E->LOCATOR_BROWSER_URL, $locator);
+    }
+    my @matches = $sps =~ $value_of{comp_pat};
+    if (!@matches) {
+        return $E->throw($E->LOCATOR_BROWSER_URL, $locator);
+    }
+    # Places the components into the template
+    my $result = $value_of{loc_tmpl};
+    for my $field_number (1 .. @matches) {
+        my $match = $matches[$field_number - 1];
+        $result =~ s/\{ $field_number \}/$match/xms;
+    }
+    my $rev_field_number = scalar(@matches) + 1;
+    my $rev_string = q{};
+    if ($rev) {
+        $rev_string = $value_of{rev_tmpl};
+        $rev_string =~ s/\{1\}/$rev/xms;
+    }
+    $result =~ s/\{ $rev_field_number \}/$rev_string/xms;
+    return $result;
+}
+
+# Exports $locator to a $dest.
+sub _export {
+    my ($attrib_ref, $locator, $dest) = @_;
+    if (_util_of_type($attrib_ref, $locator)->can('export')) {
+        _as_normalised($attrib_ref, $locator);
+        my $util_of_type = _util_of_type($attrib_ref, $locator);
+        $util_of_type->export($locator->get_value(), $dest);
+    }
+}
+
+# Returns true if it is possible to safely export $locator.
+sub _export_ok {
+    my ($attrib_ref, $locator) = @_;
+    my $util_of_type = _util_of_type($attrib_ref, $locator);
+    _as_parsed($attrib_ref, $locator);
+    $util_of_type->can('export_ok')
+        && $util_of_type->export_ok($locator->get_value());
+}
+
+# Searches the directory tree of $locator. Calls a function for each node.
+sub _find {
+    my ($attrib_ref, $locator, $callback) = @_;
+    _as_invariant($attrib_ref, $locator);
+    my $type = $locator->get_type();
+    my $util_of_type = _util_of_type($attrib_ref, $locator);
+    my $found = $util_of_type->find(
+        $locator->get_value(),
+        sub {
+            my ($value, $target_attrib_ref) = @_;
+            my $new_locator;
+            if ($value eq $locator->get_value()) {
+                $locator->set_last_mod_rev($target_attrib_ref->{last_mod_rev});
+                $locator->set_last_mod_time($target_attrib_ref->{last_mod_time});
+                $new_locator = $locator;
+            }
+            else {
+                $new_locator = FCM::Context::Locator->new($value, {
+                    last_mod_rev  => $target_attrib_ref->{last_mod_rev},
+                    last_mod_time => $target_attrib_ref->{last_mod_time},
+                    type          => $type,
+                    value_level   => FCM::Context::Locator->L_INVARIANT,
+                });
+            }
+            $callback->($new_locator, $target_attrib_ref);
+        },
+    );
+    return ($found ? $found : $E->throw($E->LOCATOR_FIND, $locator));
+}
+
+# Loads the keyword context from configuration entries.
+sub _kw_ctx_load {
+    my ($attrib_ref, @config_entry_iterators) = @_;
+    for my $config_entry_iterator (@config_entry_iterators) {
+        while (my $config_entry = $config_entry_iterator->()) {
+            my $handler = $KEYWORD_CFG_LOADER_FOR{$config_entry->get_label()};
+            if (defined($handler)) {
+                $handler->($attrib_ref, $config_entry);
+            }
+        }
+    }
+}
+
+# Loads a location keyword browser config from a configuration entry.
+sub _kw_ctx_load_browser_func {
+    my ($setter_ref) = @_;
+    sub {
+        my ($attrib_ref, $c_entry) = @_;
+        my %entry_by_key = %{$attrib_ref->{kw_ctx}->get_entry_by_key()};
+        if (@{$c_entry->get_ns_list()}) {
+            for my $key (@{$c_entry->get_ns_list()}) {
+                if (exists($entry_by_key{$key})) {
+                    $setter_ref->(
+                        $entry_by_key{$key}->get_browser_config(),
+                        $c_entry->get_value(),
+                    );
+                }
+            }
+        }
+        else {
+            $setter_ref->($attrib_ref->{browser_config}, $c_entry->get_value());
+        }
+    }
+}
+
+# Loads the location keyword context from a configuration entry.
+sub _kw_ctx_load_loc {
+    my ($attrib_ref, $c_entry) = @_;
+    my $key   = lc($c_entry->get_ns_list()->[0]);
+    my $value = $c_entry->get_value();
+    my $M     = $c_entry->get_modifier_of();
+    my $type  = (exists($M->{type}) ? $M->{type} : undef);
+    if (exists($M->{primary}) && $M->{primary}) {
+        my $locator = FCM::Context::Locator->new($value, {type => $type});
+        _as_normalised($attrib_ref, $locator);
+        my $entry = $attrib_ref->{kw_ctx}->add_entry(
+            $key, $locator->get_value(), {type => $locator->get_type()},
+        );
+        for (@KEYWORD_IMPLIED_SUFFICES) {
+            my ($value_suffix, $key_suffix_ref) = @{$_};
+            my $locator = $ACTION_OF{cat}->($attrib_ref, $locator, $value_suffix);
+            my $value = $locator->get_value();
+            for my $key_suffix (@{$key_suffix_ref}) {
+                my $implied_entry = $entry->get_ctx_of_implied()->add_entry(
+                    $key . $key_suffix, $value, {implied => 1, type => $type},
+                );
+                $attrib_ref->{kw_ctx}->add_entry($implied_entry);
+            }
+        }
+    }
+    else {
+        $attrib_ref->{kw_ctx}->add_entry($key, $value, {type => $type});
+    }
+}
+
+# Loads the revision keyword context from a configuration entry.
+sub _kw_ctx_load_rev {
+    my ($attrib_ref, $c_entry) = @_;
+    for my $ns (map {lc($_)} @{$c_entry->get_ns_list()}) {
+        my ($key, $r_key) = split(qr{:}msx, $ns);
+        my $entry = $attrib_ref->{kw_ctx}->get_entry_by_key($key);
+        if (defined($entry)) {
+            $entry->get_ctx_of_rev()->add_entry($r_key, $c_entry->get_value());
+        }
+    }
+}
+
+# Returns an iterator that returns location keyword entry context for $locator.
+sub _kw_iter {
+    my ($attrib_ref, $locator, $callback_ref) = @_;
+    my $origin = $ACTION_OF{origin}->($attrib_ref, $locator);
+    my $iter = _up_iter($attrib_ref, $origin);
+    sub {
+        while (my ($leader) = $iter->()) {
+            my $entry = $attrib_ref->{kw_ctx}->get_entry_by_value($leader);
+            if (defined($entry)) {
+                if (defined($callback_ref)) {
+                    $callback_ref->($entry);
+                }
+                return $entry;
+            }
+        }
+        return;
+    }
+}
+
+# Loads revision keywords from the "fcm:revision" property of the locator value
+# of a location keyword entry.
+sub _kw_load_rev_prop {
+    my ($attrib_ref, $entry) = @_;
+    if ($entry->get_loaded_rev_prop() || $entry->get_implied()) {
+        return;
+    }
+    $entry->set_loaded_rev_prop(1);
+    my $locator = FCM::Context::Locator->new(
+        $entry->get_value(), {type => $entry->get_type()},
+    );
+    my $property = _read_property($attrib_ref, $locator, $REV_PROP_NAME);
+    if (!$property) {
+        return;
+    }
+    for my $line (split(qr{\s*\n\s*}xms, $property)) {
+        my ($key, $value) = split($PATTERN_OF{delim_of_assign}, $line, 2);
+        $entry->get_ctx_of_rev()->add_entry($key, $value);
+    }
+}
+
+# Returns a function to "transform" a $locator to another locator.
+sub _locator_func {
+    my ($impl_ref) = @_;
+    sub {
+        my ($attrib_ref, $locator, @args) = @_;
+        _as_parsed($attrib_ref, $locator);
+        my $util_of_type = _util_of_type($attrib_ref, $locator);
+        FCM::Context::Locator->new(
+            scalar($impl_ref->($util_of_type, $locator->get_value(), @args)),
+            {type => $locator->get_type()},
+        );
+    }
+}
+
+# Returns a file handle to read the content of $locator.
+sub _reader {
+    my ($attrib_ref, $locator) = @_;
+    _as_normalised($attrib_ref, $locator);
+    my $reader = eval {
+        _util_of_type($attrib_ref, $locator)->reader($locator->get_value());
+    };
+    if (my $e = $@) {
+        return $E->throw($E->LOCATOR_READER, $locator, $e);
+    }
+    if (!defined($reader)) {
+        return $E->throw($E->LOCATOR_READER, $locator);
+    }
+    return $reader;
+}
+
+# Returns the contents in a named property of $locator
+sub _read_property {
+    my ($attrib_ref, $locator, $prop_name) = @_;
+    _as_normalised($attrib_ref, $locator);
+    my $util_of_type = _util_of_type($attrib_ref, $locator);
+    eval {$util_of_type->read_property($locator->get_value(), $prop_name)};
+}
+
+# If $locator->get_value() is a relative path, set it to a absolute path
+# base on $locator_base->get_value(), if $locator->get_type() does not differ
+# from $locator_base->get_type().
+sub _rel2abs {
+    my ($attrib_ref, $locator, $locator_base) = @_;
+    _as_normalised($attrib_ref, $locator_base);
+    if (    $locator->get_type()
+        &&  $locator->get_type() ne $locator_base->get_type()
+    ) {
+        return $locator;
+    }
+    my $value = $locator->get_value();
+    if (    $attrib_ref->{util}->uri_match($value)
+        ||  index($value, '/') == 0
+        ||  index($value, '~') == 0
+    ) {
+        return $locator;
+    }
+    my $new_locator = $ACTION_OF{cat}->($attrib_ref, $locator_base, $value);
+    $locator->set_value($new_locator->get_value());
+    $locator->set_value_level($new_locator->get_value_level());
+    $locator;
+}
+
+# Test if $locator location exists.
+sub _test_exists {
+    my ($attrib_ref, $locator) = @_;
+    _as_normalised($attrib_ref, $locator);
+    _util_of_type($attrib_ref, $locator)->test_exists($locator->get_value());
+}
+
+# Transforms a revision from/to a keyword, and returns the result.
+sub _transform_rev_keyword {
+    my ($attrib_ref, $locator, $rev, $rev_entry_func, $result_func) = @_;
+    my $iter = _kw_iter($attrib_ref, $locator);
+    while (my $entry = $iter->()) {
+        # $entry->get_ctx_of_rev()->get_entry_by_key($rev)
+        # $entry->get_ctx_of_rev()->get_entry_by_value($rev)
+        if (defined($entry->get_ctx_of_rev())) {
+            if (!$rev_entry_func->($entry->get_ctx_of_rev(), $rev)) {
+                _kw_load_rev_prop($attrib_ref, $entry);
+            }
+        }
+        if (defined($entry->get_ctx_of_rev())) {
+            my $rev_entry = $rev_entry_func->($entry->get_ctx_of_rev(), $rev);
+            if (defined($rev_entry)) {
+                # $rev_entry->get_value()
+                # $rev_entry->get_key()
+                return $result_func->($rev_entry);
+            }
+        }
+    }
+    return;
+}
+
+# Returns a string to represent the relative path to the latest main tree.
+sub _trunk_at_head {
+    my ($attrib_ref, $locator) = @_;
+    my $orig_value = $locator->get_value();
+    my $util_of_type = _util_of_type($attrib_ref, $locator);
+    my $head_value = $util_of_type->trunk_at_head($orig_value);
+    if (!$head_value || $head_value eq $orig_value) {
+        return;
+    }
+    return FCM::Context::Locator->new($head_value, {
+        type => $locator->get_type(),
+    });
+}
+
+# Determines the type of the $locator.
+sub _what_type {
+    my ($attrib_ref, $locator) = @_;
+    if (!defined($locator->get_type())) {
+        _as_parsed($attrib_ref, $locator);
+        TYPE:
+        for my $key (@{$attrib_ref->{types}}) {
+            if (!exists($attrib_ref->{type_util_of}{$key})) {
+                next TYPE;
+            }
+            my $util_of_type = $attrib_ref->{type_util_of}{$key};
+            if ($util_of_type->can_work_with($locator->get_value())) {
+                $locator->set_type($key);
+                last TYPE;
+            }
+        }
+    }
+    return $locator->get_type();
+}
+
+# Returns an iterator that walks up the hierarchy of the $locator.
+sub _up_iter {
+    my ($attrib_ref, $locator) = @_;
+    my $util_of_type = _util_of_type($attrib_ref, $locator);
+    my ($target, $revision) = $util_of_type->parse($locator->get_value());
+    my $leader = $target;
+    sub {
+        if (!defined($leader)) {
+            $leader = $target;
+            return;
+        }
+        my $return = $leader;
+        $leader = $util_of_type->dir($return);
+        if ($return eq $leader) {
+            $leader = undef;
+        }
+        return $util_of_type->parse($return, $revision);
+    };
+}
+
+# Returns the utility that implements the functionality for the $locator's type.
+sub _util_of_type {
+    my ($attrib_ref, $locator) = @_;
+    my $type = _what_type($attrib_ref, $locator);
+    if (exists($attrib_ref->{type_util_of}{$type})) {
+        return $attrib_ref->{type_util_of}{$type};
+    }
+    return $E->throw($E->LOCATOR_TYPE, $locator);
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Util::Locator
+
+=head1 SYNOPSIS
+
+    use FCM::Util;
+    my $util = FCM::Util->new(\%attrib);
+
+    # Usage
+    $ctx = $util->loc_kw_ctx();
+    @location_keyword_ctx_list = $util->loc_kw_ctx($locator);
+
+    $type = $util->loc_what_type($locator);
+    ($time, $rev) = $util->loc_when_modified($locator);
+
+    $locator_value = $util->loc_as_normalised($locator);
+    $locator_value = $util->loc_as_invariant( $locator);
+    $locator_value = $util->loc_as_keyword(   $locator);
+
+    $url = $util->loc_browser_url($locator);
+
+    $locator_of_parent = $util->loc_dir($locator);
+    $locator_of_child  = $util->loc_cat($locator, @paths);
+    $locator_of_origin = $util->loc_origin($locator);
+
+    $iter = $util->loc_up_iter($locator);
+    while (my $value = $iter->()) {
+        # ...
+    }
+
+    $reader = $util->loc_reader($locator);
+
+=head1 DESCRIPTION
+
+This module is part of L<FCM::Util|FCM::Util>. It implements the loc_* methods.
+
+=head1 IMPLEMENTATION
+
+The manipulations of locator values rely on objects with the following
+interface:
+
+=over 4
+
+=item $util_of_type->as_invariant($locator_value)
+
+Should return the invariant form of $locator_value.
+
+=item $util_of_type->can_work_with($locator_value)
+
+Should return true if it can work with $locator_value, i.e. $locator_value is a
+valid type of locator for the utility.
+
+=item $util_of_type->can_work_with_rev($revision_value)
+
+Should return true if it can work with $revision_value, i.e. $revision_value is
+a valid revision for the utility.
+
+=item $util_of_type->cat($locator_value, @paths)
+
+Should concatenate $locator_value and @paths with appropriate separators and
+returns the result.
+
+=item $util_of_type->dir($locator_value)
+
+Should return the parent (directory) of $locator_value.
+
+=item $util_of_type->export($locator_value,$dest)
+
+Optional. Exports a clean directory tree from $locator_value to $dest.
+
+=item $util_of_type->export_ok($locator_value)
+
+Optional. Returns true if it is safe to export $locator_value. E.g. it is not
+safe to export a SVN working copy, because it may contain unversioned items.
+
+=item $util_of_type->find($locator_value,$callback)
+
+Should search the directory tree in $locator_value and for each node (directory
+or file, inclusive of $locator_value), invoke
+$callback->($locator_value_of_child,\%attrib_of_child). %attrib_of_child should
+contain the elements as described by $util->find($locator,$callback).
+
+=item $util_of_type->origin($locator_value)
+
+Should return the origin of $locator_value. E.g. the URL of a Subversion working
+copy.
+
+=item $util_of_type->parse($locator_value)
+
+Should return an absolute and tidied version of $locator_value. In list context,
+should return a 2-element list, separate the scalar context return value into
+the components (PATH,REV).
+
+=item $util_of_type->reader($locator_value)
+
+Should return a file handle for reading the content of $locator_value.
+
+=item $util_of_type->read_property($locator_value,$property_name)
+
+Should return the value of the named property in $locator_value, or undef if
+not relevant for the $locator_value.
+
+=item $util_of_type->test_exists($locator_value)
+
+Should return a true value if the location $locator_value exists.
+
+=item $util_of_type->trunk_at_head($locator_value)
+
+If relevant, should append a string to $locator_value that represents the
+recommended relative path to the latest version of the main tree of a project of
+this type. E.g. for "svn", this should be "$locator_value/trunk@HEAD".
+
+=back
+
+=head1 CONSTANTS
+
+These global variables are for reference only. Their values should not be
+modified. Instead, use the appropriate attributes of the $class->new(\%attrib)
+method to modify the behaviour.
+
+=over 4
+
+=item %FCM::Util::Locator::BROWSER_CONFIG
+
+The default browser configuration.
+
+=item FCM::Util::Locator::PREFIX
+
+The URI prefix for a FCM location keyword.
+
+=item $FCM::Util::Locator::REV_PROP_NAME
+
+The name of the property where revision keywords are set in primary locations.
+
+=item @FCM::Util::Locator::TYPES
+
+The known locator types.
+
+=item %FCM::Util::Locator::TYPE_UTIL_CLASS_OF
+
+Maps the known locator types with their utility classes.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Locator/FS.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Locator/FS.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Locator/FS.pm	(revision 5095)
@@ -0,0 +1,203 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Util::Locator::FS;
+use base qw{FCM::Class::CODE};
+
+use File::Basename qw{dirname};
+use File::Find qw{};
+use File::Spec;
+
+our %ACTION_OF = (
+    can_work_with     => sub {1},
+    can_work_with_rev => sub {},
+    cat               => \&_cat,
+    dir               => \&_dir,
+    find              => \&_find,
+    origin            => \&_parse,
+    parse             => \&_parse,
+    reader            => \&_reader,
+    read_property     => sub {},
+    test_exists       => \&_test_exists,
+    trunk_at_head     => sub {},
+);
+
+# Creates the class.
+__PACKAGE__->class({util => '&'}, {action_of => \%ACTION_OF});
+
+# Joins @paths to the end of $value.
+sub _cat {
+    my ($attrib_ref, $value, @paths) = @_;
+    _parse(
+        $attrib_ref,
+        File::Spec->catfile(scalar(_parse($attrib_ref, $value)), @paths),
+    );
+}
+
+# Returns the directory name of $value.
+sub _dir {
+    my ($attrib_ref, $value) = @_;
+    dirname(scalar(_parse($attrib_ref, $value)));
+}
+
+# Searches directory tree.
+sub _find {
+    my ($attrib_ref, $value, $callback) = @_;
+    my $found;
+    File::Find::find(
+        sub {
+            $found ||= 1;
+            my $path = $File::Find::name;
+            my $ns = File::Spec->abs2rel($path, $value);
+            if ($ns eq q{.}) {
+                $ns = q{};
+            }
+            else {
+                for my $name (split(q{/}, $ns)) {
+                    if (index($name, q{.}) == 0) {
+                        return; # ignore Unix hidden/system files
+                    }
+                }
+            }
+            my $last_mod_time = (-l $path ? lstat($path) : stat($path))[9];
+            $callback->(
+                $path,
+                {   is_dir        => scalar(-d $path),
+                    last_mod_rev  => undef,
+                    last_mod_time => $last_mod_time,
+                    ns            => $ns,
+                },
+            );
+        },
+        $value,
+    );
+    return $found;
+}
+
+# Returns $value in scalar context, or ($value,undef) in list context.
+sub _parse {
+    my ($attrib_ref, $value) = @_;
+    $value = $attrib_ref->{util}->file_tilde_expand($value);
+    $value = File::Spec->rel2abs($value);
+    my ($vol, $dir_name, $base) = File::Spec->splitpath($value);
+    my @dir_names;
+    my %HANDLER_OF = (
+        q{}   => sub {push(@dir_names, $_[0])},
+        q{.}  => sub {},
+        q{..} => sub {if (@dir_names > 1) {pop(@dir_names)}},
+    );
+    for my $name (File::Spec->splitdir($dir_name)) {
+        my $handler
+            = exists($HANDLER_OF{$name}) ? $HANDLER_OF{$name} : $HANDLER_OF{q{}};
+        $handler->($name);
+    }
+    $value = File::Spec->catpath($vol, File::Spec->catdir(@dir_names), $base);
+    return (wantarray() ? ($value, undef) : $value);
+}
+
+# Returns a reader (file handle) for a given file system value.
+sub _reader {
+    my ($attrib_ref, $value) = @_;
+    $value = _parse($attrib_ref, $value);
+    open(my $handle, '<', $value) || die("$!\n");
+    return $handle;
+}
+
+# Return a true value if the location $value exists.
+sub _test_exists {
+    my ($attrib_ref, $value) = @_;
+    -e $value;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Util::Locator::FS
+
+=head1 SYNOPSIS
+
+    use FCM::Util::Locator::FS;
+    $util = FCM::Util::Locator::FS->new(\%option);
+    $handle = $util->reader($value);
+
+=head1 DESCRIPTION
+
+Provides utilities to manipulate the values of file system locators.
+
+=head1 METHODS
+
+=over 4
+
+=item $util->can_work_with($value)
+
+Dummy. Always returns true.
+
+=item $util->can_work_with_rev($revision)
+
+Dummy. Always returns false.
+
+=item $util->cat($value,@paths)
+
+Joins @paths to the end of $value.
+
+=item $util->dir($value)
+
+Returns the parent directory of $value.
+
+=item $util->find($value,$callback)
+
+Searches directory tree of $value.
+
+=item $util->origin($value)
+
+Alias of $util->parse($value).
+
+=item $util->parse($value)
+
+In scalar context, returns $value. In list context, returns ($value,undef).
+
+=item $util->reader($value)
+
+Returns a file handle for $value, if it is a readable regular file.
+
+=item $util->read_property($value,$property_name)
+
+Dummy. Always returns undef.
+
+=item $util->test_exists($value)
+
+Return a true value if the location $value exists.
+
+=item $util->trunk_at_head($value)
+
+Dummy. Always returns undef.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Locator/SSH.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Locator/SSH.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Locator/SSH.pm	(revision 5095)
@@ -0,0 +1,251 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Util::Locator::SSH;
+use base qw{FCM::Class::CODE};
+
+use FCM::Util::Exception;
+use File::Temp;
+use Text::ParseWords qw{shellwords};
+
+our %ACTION_OF = (
+    can_work_with     => \&_can_work_with,
+    can_work_with_rev => sub {},
+    cat               => \&_cat,
+    dir               => \&_dir,
+    export            => \&_export,
+    export_ok         => sub {1},
+    find              => \&_find,
+    origin            => \&_parse,
+    parse             => \&_parse,
+    reader            => \&_reader,
+    read_property     => sub {},
+    test_exists       => \&_test_exists,
+    trunk_at_head     => sub {},
+);
+# Alias to the exception class
+my $E = 'FCM::Util::Exception';
+
+# Creates the class.
+__PACKAGE__->class(
+    {type_util_of => '%', util => '&'},
+    {action_of => \%ACTION_OF},
+);
+
+# Returns true if $value looks like a legitimate HOST:PATH.
+sub _can_work_with {
+    my ($attrib_ref, $value) = @_;
+    if (!$value) {
+        return;
+    }
+    if (index($value, ':') < 0) {
+        return;
+    }
+    my ($auth) = split(':', $value, 2);
+    my $host = index($auth, '@') >= 0 ? (split('@', $auth, 2))[1] : $auth;
+    $host ? gethostbyname($host) : undef;
+}
+
+# Joins @paths to the end of $value.
+sub _cat {
+    my ($attrib_ref, $value, @paths) = @_;
+    my ($auth, $path) = split(':', $value, 2);
+    $auth . ':' . $attrib_ref->{type_util_of}{fs}->cat($path, @paths);
+}
+
+# Returns the directory name of $value.
+sub _dir {
+    my ($attrib_ref, $value) = @_;
+    my ($auth, $path) = split(':', $value, 2);
+    $auth . ':' . $attrib_ref->{type_util_of}{fs}->dir($path);
+}
+
+# Rsync $value to $dest.
+sub _export {
+    my ($attrib_ref, $value, $dest) = @_;
+    my ($auth, $path) = _dir($attrib_ref, $value);
+    my $value_hash_ref = $attrib_ref->{util}->shell_simple([
+        _shell_cmd_list($attrib_ref, 'rsync'),
+        $value . '/',
+        $dest,
+    ]);
+    if ($value_hash_ref->{rc}) {
+        die($value_hash_ref);
+    }
+}
+
+# Searches directory tree.
+sub _find {
+    my ($attrib_ref, $value, $callback) = @_;
+    my ($auth, $path) = split(':', $value, 2);
+    my $value_hash_ref = $attrib_ref->{util}->shell_simple([
+        _shell_cmd_list($attrib_ref, 'ssh'),
+        $auth,
+        "find $path -type f -not -path \"*/.*\" -printf \"%T@ %p\\\\n\"",
+    ]);
+    if ($value_hash_ref->{rc}) {
+        die($value_hash_ref);
+    }
+    my $found;
+    LINE:
+    for my $line (grep {$_} split("\n", $value_hash_ref->{o})) {
+        $found ||= 1;
+        my ($mtime, $name) = split(q{ }, $line, 2);
+        my $ns = substr($name, length($path) + 1);
+        $callback->(
+            $auth . ':' . $name,
+            {   is_dir        => undef,
+                last_mod_rev  => undef,
+                last_mod_time => $mtime,
+                ns            => $ns,
+            },
+        );
+    }
+    $found;
+}
+
+# Returns a reader (file handle) for a given file system value.
+sub _reader {
+    my ($attrib_ref, $value) = @_;
+    my ($auth, $path) = split(':', $value, 2);
+    my $handle = File::Temp->new();
+    my $e;
+    my $rc = $attrib_ref->{util}->shell(
+        [_shell_cmd_list($attrib_ref, 'ssh'), $auth, 'cat', $path],
+        {'e' => \$e, 'o' => sub {print($handle $_[0])}},
+    );
+    if ($rc) {
+        die($e);
+    }
+    seek($handle, 0, 0);
+    return $handle;
+}
+
+# Returns $value in scalar context, or ($value,undef) in list context.
+sub _parse {
+    my ($attrib_ref, $value) = @_;
+    my ($auth, $path) = split(':', $value, 2);
+    $value = $auth . ':' . $attrib_ref->{type_util_of}{fs}->parse($path);
+    return (wantarray() ? ($value, undef) : $value);
+}
+
+# Return a true value if the location $value exists.
+sub _test_exists {
+    my ($attrib_ref, $value) = @_;
+    my ($auth, $path) = split(':', $value, 2);
+    my $value_hash_ref = $attrib_ref->{util}->shell_simple([
+        _shell_cmd_list($attrib_ref, 'ssh'), $auth, "test -e '$path'",
+    ]);
+    return !$value_hash_ref->{rc};
+}
+
+# Get a named command and its flags, return a list.
+sub _shell_cmd_list {
+    my ($attrib_ref, $key) = @_;
+    map {shellwords($_)} (
+        $attrib_ref->{util}->external_cfg_get($key),
+        $attrib_ref->{util}->external_cfg_get($key . '.flags'),
+    );
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Util::Locator::SSH
+
+=head1 SYNOPSIS
+
+    use FCM::Util::Locator::SSH;
+    $util = FCM::Util::Locator::SSH->new(\%option);
+    $handle = $util->reader($value);
+
+=head1 DESCRIPTION
+
+Provides utilities to manipulate the values of locators on file systems on
+remote hosts accessible via SSH and RSYNC.
+
+=head1 METHODS
+
+=over 4
+
+=item $util->can_work_with($value)
+
+Returns true if $value is in the form AUTH:PATH and AUTH is a valid user@host.
+
+=item $util->can_work_with_rev($revision)
+
+Dummy. Always returns false.
+
+=item $util->cat($value,@paths)
+
+Joins @paths to the end of $value.
+
+=item $util->dir($value)
+
+Returns the auth:parent-directory of $value.
+
+=item $util->export($value,$dest)
+
+Rsync a clean directory tree of $value to $dest.
+
+=item $util->export_ok($value)
+
+Returns true if $util->can_work_with($value).
+
+=item $util->find($value,$callback)
+
+Searches directory tree of $value.
+
+=item $util->origin($value)
+
+Alias of $util->parse($value).
+
+=item $util->parse($value)
+
+In scalar context, returns $value. In list context, returns ($value,undef).
+
+=item $util->reader($value)
+
+Returns a file handle for $value, if it is a readable regular file.
+
+=item $util->read_property($value,$property_name)
+
+Dummy. Always returns undef.
+
+=item $util->test_exists($value)
+
+Return a true value if the location $value exists.
+
+=item $util->trunk_at_head($value)
+
+Dummy. Always returns undef.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Locator/SVN.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Locator/SVN.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Locator/SVN.pm	(revision 5095)
@@ -0,0 +1,458 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Util::Locator::SVN;
+use base qw{FCM::Class::CODE};
+
+use File::Temp;
+use POSIX qw{setlocale LC_ALL};
+use Time::Piece;
+
+our %ACTION_OF = (
+    as_invariant      => \&_as_invariant,
+    can_work_with     => \&_can_work_with,
+    can_work_with_rev => \&_can_work_with_rev,
+    cat               => \&_cat,
+    dir               => \&_dir,
+    export            => \&_export,
+    export_ok         => \&_export_ok,
+    find              => \&_find,
+    origin            => \&_origin,
+    parse             => \&_parse,
+    reader            => \&_reader,
+    read_property     => \&_read_property,
+    test_exists       => \&_test_exists,
+    trunk_at_head     => \&_trunk_at_head,
+);
+
+my %PATTERN_OF = (
+    REVISION       => qr{\A(?:\d+|HEAD|BASE|COMMITTED|PREV|\{[^\}]+\})\z}ixms,
+    TARGET_PEG     => qr{\A(.+?)(?:@([^/@]+))?\z}xms,
+    URL_COMPONENTS => qr{\A([A-Za-z][\w\.\+\-]*://)([^/]*)(/?.*)\z}xms,
+);
+
+my %INFO_OF = (
+    'Path'                => 'path',
+    'URL'                 => 'URL',
+    'Repository Root'     => 'repos_root_URL',
+    'Repository UUID'     => 'repos_UUID',
+    'Revision'            => 'rev',
+    'Node Kind'           => 'kind',
+    'Last Changed Author' => 'last_changed_author',
+    'Last Changed Rev'    => 'last_changed_rev',
+    'Last Changed Date'   => 'last_changed_date',
+    # FIXME: currently omitting lock info and other WC info.
+);
+
+my %INFO_KIND_OF = (directory => 'dir', file => 'file');
+
+my %INFO_MOD_OF = (
+    last_changed_date => \&_svn_info_last_changed_date,
+    kind => sub {exists($INFO_KIND_OF{$_[0]}) ? $INFO_KIND_OF{$_[0]} : $_[0]},
+);
+
+# Creates the class.
+__PACKAGE__->class(
+    {type_util_of => '%', util => '&'},
+    {action_of => \%ACTION_OF},
+);
+
+# Returns the invariant version of $value.
+sub _as_invariant {
+    my ($attrib_ref, $value) = @_;
+    my ($target, $revision) = _parse($attrib_ref, $value);
+    if (!$attrib_ref->{util}->uri_match($target) && !$revision) {
+        return;
+    }
+    $revision ||= $attrib_ref->{util}->uri_match($target) ? 'HEAD' : 'BASE';
+    my %info_of;
+    _svn_info(
+        $attrib_ref,
+        sub {%info_of = %{$_[0]}},
+        [$value],
+    );
+    return _parse_simple($attrib_ref, $info_of{URL}, $info_of{rev});
+}
+
+# Returns true if $value looks like a legitimate SVN target.
+sub _can_work_with {
+    my ($attrib_ref, $value) = @_;
+    my ($scheme) = $attrib_ref->{util}->uri_match($value);
+    if ($scheme && grep {$_ eq $scheme} qw{svn file svn+ssh http https}) {
+        return $value;
+    }
+    my ($target, $revision) = _parse($attrib_ref, $value);
+    my $url;
+    local($@);
+    eval {_svn_info($attrib_ref, sub {$url = $_[0]->{URL}}, [$target])};
+    return $url;
+}
+
+# Returns true if $revision looks like a legitimate SVN revision specifier.
+sub _can_work_with_rev {
+    my ($attrib_ref, $revision) = @_;
+    if (!defined($revision)) {
+        return;
+    }
+    return $revision =~ $PATTERN_OF{REVISION};
+}
+
+# Joins @paths to the end of $value.
+sub _cat {
+    my ($attrib_ref, $value, @paths) = @_;
+    my ($target, $rev) = _parse($attrib_ref, $value);
+    my $is_uri = $attrib_ref->{util}->uri_match($target);
+    $target
+        = $is_uri ? join('/', $target, @paths)
+        :           $attrib_ref->{type_util_of}{fs}->cat($target, @paths)
+        ;
+    _parse_simple($attrib_ref, _tidy($target), $rev);
+}
+
+# Returns the directory containing $value.
+sub _dir {
+    my ($attrib_ref, $value) = @_;
+    my ($target, $revision) = _parse($attrib_ref, $value);
+    if ($attrib_ref->{util}->uri_match($target)) {
+        my ($leader, $auth, $trailer) = $target =~ $PATTERN_OF{URL_COMPONENTS};
+        if (!$trailer) {
+            return _parse($attrib_ref, $target, $revision);
+        }
+        $trailer =~ s{/+ [^/]* \z}{}xms;
+        $target = $leader . ($auth ? $auth : q{}) . $trailer;
+    }
+    else {
+        $target = $attrib_ref->{type_util_of}{fs}->dir($target);
+    }
+    _parse_simple($attrib_ref, $target, $revision);
+}
+
+# Export $value to $dest.
+sub _export {
+    my ($attrib_ref, $value, $dest) = @_;
+    _run_svn_simple($attrib_ref, 'export', [$value, $dest], {quiet => undef});
+}
+
+# Returns true if $value is a URL.
+sub _export_ok {
+    my ($attrib_ref, $value) = @_;
+    $attrib_ref->{util}->uri_match($value);
+}
+
+# Searches directory tree of $value.
+sub _find {
+    my ($attrib_ref, $value, $callback) = @_;
+    if (!$attrib_ref->{util}->uri_match($value)) {
+        return $attrib_ref->{type_util_of}{fs}->find($value, $callback);
+    }
+    _svn_info(
+        $attrib_ref,
+        sub {
+            my ($info_ref) = @_;
+            $callback->(
+                $info_ref->{URL} . '@' . $info_ref->{rev},
+                {   is_dir        => $info_ref->{kind} eq 'dir',
+                    last_mod_rev  => $info_ref->{last_changed_rev},
+                    last_mod_time => $info_ref->{last_changed_date},
+                    ns            => $info_ref->{path},
+                },
+            );
+        },
+        [$value],
+        {recursive => undef},
+    );
+    return 1;
+}
+
+# Returns the URL version of $value.
+sub _origin {
+    my ($attrib_ref, $value) = @_;
+    my ($target, $revision) = _parse($attrib_ref, $value);
+    if ($attrib_ref->{util}->uri_match($target)) {
+        return _parse_simple($attrib_ref, $value);
+    }
+    $revision ||= 'BASE';
+    _as_invariant(
+        $attrib_ref,
+        scalar(_parse_simple($attrib_ref, $target, $revision)),
+    );
+}
+
+# In list context, returns ($target, $revision). In scalar context, returns
+# "$target@$revision".
+sub _parse {
+    my ($attrib_ref, $value, $revision) = @_;
+    my ($target, $peg_revision) = $value =~ $PATTERN_OF{TARGET_PEG};
+    if ($peg_revision) {
+        $revision = $peg_revision;
+    }
+    $target
+        = $attrib_ref->{util}->uri_match($value)
+        ? _tidy($target)
+        : $attrib_ref->{type_util_of}{fs}->parse($target)
+        ;
+    _parse_simple($attrib_ref, $target, $revision);
+}
+
+# Same as _parse, but without _tidy.
+sub _parse_simple {
+    my ($attrib_ref, $value, $revision) = @_;
+    (
+        wantarray() ? ($value, $revision)
+        :             $value . ($revision ? q{@} . $revision : q{})
+    );
+}
+
+# Returns a named property of a Subversion target.
+sub _read_property {
+    my ($attrib_ref, $value, $name) = @_;
+    _run_svn_simple($attrib_ref, 'pg', [$name, $value]);
+}
+
+# Returns a reader (file handle) for a given Subversion target.
+sub _reader {
+    my ($attrib_ref, $value) = @_;
+    my ($target, $revision) = _parse($attrib_ref, $value);
+    if ($attrib_ref->{util}->uri_match($target) || $revision) {
+        return _run_svn_handle($attrib_ref, 'cat', [$value]);
+    }
+    else {
+        return $attrib_ref->{type_util_of}{fs}->reader($target);
+    }
+}
+
+# Helper for _run_svn_*, generates the command.
+sub _run_svn_command {
+    my ($attrib_ref, $key, $args_ref, $option_ref) = @_;
+    $args_ref   ||= [];
+    $option_ref ||= {};
+    my @options;
+    while (my ($key, $value) = each(%{$option_ref})) {
+        push(@options, '--' . $key . (defined($value) ? '=' . $value : q{}));
+    }
+    ['svn', $key, @options, @{$args_ref}];
+}
+
+# Runs "svn", sending standard output to a file handle.
+sub _run_svn_handle {
+    my ($attrib_ref, $key, $args_ref, $option_ref) = @_;
+    local($ENV{LANG}) = $ENV{LANG};
+    if (setlocale(LC_ALL, 'en_GB')) {
+        $ENV{LANG} = 'en_GB';
+    }
+    my $handle = File::Temp->new();
+    my $rc = $attrib_ref->{util}->shell(
+        _run_svn_command(@_),
+        {e => \my($err), o => sub {print($handle $_[0])}},
+    );
+    if ($rc || (!tell($handle) && $err)) { # cat, info, etc may return 0 on err
+        chomp($err);
+        die("$err\n");
+    }
+    seek($handle, 0, 0);
+    return $handle;
+}
+
+# Runs a simple "svn" command.
+sub _run_svn_simple {
+    my ($attrib_ref, $key, $args_ref, $option_ref) = @_;
+    local($ENV{LANG}) = $ENV{LANG};
+    if (setlocale(LC_ALL, 'en_GB')) {
+        $ENV{LANG} = 'en_GB';
+    }
+    my $value_hash_ref
+        = $attrib_ref->{util}->shell_simple(_run_svn_command(@_));
+    if ($value_hash_ref->{rc}) {
+        die($value_hash_ref);
+    }
+    $value_hash_ref->{o};
+}
+
+# Runs "svn info".
+sub _svn_info {
+    my ($attrib_ref, $callback_ref, $args_ref, $option_ref) = @_;
+    my $handle = _run_svn_handle($attrib_ref, 'info', $args_ref, $option_ref);
+    my %hash;
+    while (my $line = readline($handle)) {
+        chomp($line);
+        if ($line) {
+            my ($key, $value) = split(qr{:\s*}msx, $line, 2);
+            if (exists($INFO_OF{$key})) {
+                my $id = $INFO_OF{$key};
+                $hash{$id}
+                    = exists($INFO_MOD_OF{$id}) ? $INFO_MOD_OF{$id}->($value)
+                    :                             $value
+                    ;
+            }
+        }
+        else {
+            $callback_ref->(\%hash);
+        }
+    }
+}
+
+# Parse last changed date from "svn info".
+sub _svn_info_last_changed_date {
+    my $text = (split(qr{\s+\(}msx, $_[0], 2))[0];
+    my $head = Time::Piece->strptime(substr($text, 0, -6), '%Y-%m-%d %H:%M:%S');
+    my $tail = substr($text, -5);
+    my ($tz_sign, $tz_h, $tz_m) = $tail =~ qr{([\-\+])(\d\d)(\d\d)}msx;
+    $head->epoch() - int($tz_sign . 1) * ($tz_h * 3600 + $tz_m * 60);
+}
+
+# Return a true value if the location $value exists.
+sub _test_exists {
+    my ($attrib_ref, $value) = @_;
+    my $url;
+    eval {_svn_info($attrib_ref, sub {$url = $_[0]->{URL}}, [$value])};
+    return $url;
+}
+
+# Returns a tidied version of a Subversion URL.
+sub _tidy {
+    my ($url) = @_;
+    my ($leader, $auth, $trailer) = $url =~ $PATTERN_OF{URL_COMPONENTS};
+    if (!$trailer) {
+        return $url;
+    }
+    my @tidied_names;
+    my %handler_of = (
+        q{}   => sub {push(@tidied_names, $_[0])},
+        q{.}  => sub {},
+        q{..} => sub {if (@tidied_names > 1) {pop(@tidied_names)}},
+    );
+    for my $name (split(qr{/+}xms, $trailer)) {
+        my $handler
+            = exists($handler_of{$name}) ? $handler_of{$name} : $handler_of{q{}};
+        $handler->($name);
+    }
+    return $leader . ($auth ? $auth : q{}) . join(q{/}, @tidied_names);
+}
+
+# Returns trunk@HEAD for a URL.
+sub _trunk_at_head {
+    my ($attrib_ref, $target) = @_;
+    if (!$attrib_ref->{util}->uri_match($target)) {
+        return;
+    }
+    _cat($attrib_ref, $target, 'trunk@HEAD');
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Util::Locator::SVN
+
+=head1 SYNOPSIS
+
+    use FCM::Util;
+    $util = FCM::Util->new(\%attrib);
+    $reader = $util->loc_reader($locator);
+
+
+=head1 DESCRIPTION
+
+This is part of L<FCM::Util|FCM::Util>. Provides utilities for Subversion
+targets.
+
+=head1 ATTRIBUTES
+
+=over 4
+
+=item util
+
+The L<FCM::Util|FCM::Util> object that initialised this object.
+
+=head1 METHODS
+
+=over 4
+
+=item $util->as_invariant($value)
+
+Returns the invariant version of $value. For example, if the current HEAD
+revision is 1234, and $value is C<svn://foo/bar/baz> or
+C<svn://foo/bar/baz@HEAD>, it will return C<svn://foo/bar/baz@1234>.
+
+=item $util->can_work_with($value)
+
+Returns the URL form of $value (true) if $value is a valid SVN target.
+
+=item $util->can_work_with_rev($revision)
+
+Returns true if $revision looks like a legitimate SVN revision specifier.
+
+=item $util->cat($value,@paths)
+
+Join @paths to the end of $value.
+
+=item $util->dir($value)
+
+Returns the directory name of $value.
+
+=item $util->export($value,$dest)
+
+Exports a clean directory tree of $value to $dest.
+
+=item $util->export_ok($value)
+
+Returns true if $value is a URL. (It is not safe to export a working copy.)
+
+=item $util->find($value,$callback)
+
+Searches directory tree of $value.
+
+=item $util->origin($value)
+
+Returns the URL version of $value.
+
+=item $util->parse($value,$revision)
+
+In scalar context, returns a string in C<TARGET@REV> for $value. In list
+context, given C<TARGET@REV> returns (C<TARGET>, C<REV>). If $value has a peg
+revision, it overrides the specified $revision.
+
+=item $util->reader($value)
+
+Returns a file handle for reading the content in $value, if possible.
+
+=item $util->read_property($value,$name)
+
+Returns the value of a property $name of $value.
+
+=item $util->test_exists($value)
+
+Return a true value if the location $value exists.
+
+=item $util->trunk_at_head($value)
+
+Returns "$value/trunk@HEAD' if $value is a URI or undef otherwise.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Reporter.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Reporter.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Reporter.pm	(revision 5095)
@@ -0,0 +1,382 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Util::Reporter;
+use base qw{FCM::Class::CODE};
+
+use Scalar::Util qw{reftype};
+
+use constant {TYPE_OUT => 1, TYPE_ERR => 2};
+
+use constant {  DEFAULT => 1,
+    FAIL  => 0, WARN    => 1,
+    QUIET => 0, LOW     => 1, MEDIUM => 2, HIGH => 3, DEBUG => 4,
+};
+
+use constant {
+    PREFIX_DONE => q{[done] },
+    PREFIX_FAIL => q{[FAIL] },
+    PREFIX_INFO => q{[info] },
+    PREFIX_INIT => q{[init] },
+    PREFIX_NULL => q{},
+    PREFIX_QUIT => q{[quit] },
+    PREFIX_WARN => q{[WARN] },
+};
+
+# Creates the class.
+__PACKAGE__->class(
+    {ctx_of => '%'},
+    {   init => sub {
+            my ($attrib_ref) = @_;
+            %{$attrib_ref->{ctx_of}} = (
+                stderr => FCM::Util::Reporter::Context->new_err(),
+                stdout => FCM::Util::Reporter::Context->new(),
+            );
+        },
+        action_of => {
+            add_ctx           => \&_add_ctx,
+            del_ctx           => \&_del_ctx,
+            get_ctx           => \&_get_ctx,
+            get_ctx_of_stderr => sub {$_[0]->{ctx_of}->{stderr}},
+            get_ctx_of_stdout => sub {$_[0]->{ctx_of}->{stdout}},
+            report            => \&_report,
+        }
+    },
+);
+
+# Adds a named reporter context.
+sub _add_ctx {
+    my ($attrib_ref, $key, @args) = @_;
+    if (exists($attrib_ref->{ctx_of}->{$key})) {
+        return;
+    }
+    $attrib_ref->{ctx_of}->{$key} = FCM::Util::Reporter::Context->new(@args);
+}
+
+# Deletes a named reporter context.
+sub _del_ctx {
+    my ($attrib_ref, $key) = @_;
+    if (!exists($attrib_ref->{ctx_of}->{$key})) {
+        return;
+    }
+    delete($attrib_ref->{ctx_of}->{$key});
+}
+
+# Returns a named reporter context.
+sub _get_ctx {
+    my ($attrib_ref, $key) = @_;
+    if (!exists($attrib_ref->{ctx_of}->{$key})) {
+        return;
+    }
+    $attrib_ref->{ctx_of}->{$key};
+}
+
+# Reports message.
+sub _report {
+    my ($attrib_ref, @args) = @_;
+    if (!@args) {
+        return;
+    }
+    my %option = (
+        delimiter => "\n",
+        level     => DEFAULT,
+        prefix    => undef,
+        type      => TYPE_OUT,
+    );
+    if (ref($args[0]) && reftype($args[0]) eq 'HASH') {
+        %option = (%option, %{shift(@args)});
+    }
+    # Auto remove ctx with closed file handle
+    while (my ($key, $ctx) = each(%{$attrib_ref->{ctx_of}})) {
+        if (!defined(fileno($ctx->get_handle()))) {
+            delete($attrib_ref->{ctx_of}->{$key});
+        }
+    }
+    # Selects handles
+    my @ctx_and_prefix_list
+        =   map  {
+                my $prefix = defined($option{prefix})
+                    ? $option{prefix} : $_->get_prefix();
+                if (ref($prefix) && reftype($prefix) eq 'CODE') {
+                    $prefix = $prefix->($option{level}, $option{type});
+                }
+                [$_, $prefix],
+            }
+            grep {  (!$_->get_type() || $_->get_type() eq $option{type})
+                &&  $_->get_verbosity() >= $option{level}
+            }
+            values(%{$attrib_ref->{ctx_of}});
+    if (!@ctx_and_prefix_list) {
+        return;
+    }
+    for my $arg (@args) {
+        for (@ctx_and_prefix_list) {
+            my ($ctx, $prefix) = @{$_};
+            my $handle = $ctx->get_handle();
+            if ($option{delimiter}) {
+                for my $item (
+                    map {grep {$_ ne "\n"} split(qr{(\n)}msx)} (
+                          !ref($arg)               ? ($arg)
+                        : reftype($arg) eq 'ARRAY' ? @{$arg}
+                        : reftype($arg) eq 'CODE'  ? $arg->($ctx->get_verbosity())
+                        :                            ($arg)
+                    )
+                ) {
+                    print({$handle} $prefix . $item . $option{delimiter});
+                }
+            }
+            else {
+                print({$handle} $arg);
+            }
+        }
+    }
+    1;
+}
+
+# ------------------------------------------------------------------------------
+package FCM::Util::Reporter::Context;
+use base qw{FCM::Class::HASH};
+
+# Creates the class.
+__PACKAGE__->class(
+    {   handle    => {isa => '*', default => \*STDOUT                     },
+        prefix    => {            default => sub {\&_prefix}              },
+        type      => {isa => '$', default => FCM::Util::Reporter->TYPE_OUT},
+        verbosity => {isa => '$', default => FCM::Util::Reporter->DEFAULT },
+    },
+);
+
+# Returns a new reporter context to STDERR.
+sub new_err {
+    my ($class, $attrib_ref) = @_;
+    $class->new({
+        handle => \*STDERR,
+        type   => FCM::Util::Reporter->TYPE_ERR,
+        (defined($attrib_ref) ? %{$attrib_ref} : ()),
+    });
+}
+
+# The default prefix function.
+sub _prefix {
+    my ($level, $type) = @_;
+      $type eq FCM::Util::Reporter->TYPE_OUT ? FCM::Util::Reporter->PREFIX_INFO
+    : $level > FCM::Util::Reporter->FAIL     ? FCM::Util::Reporter->PREFIX_WARN
+    :                                          FCM::Util::Reporter->PREFIX_FAIL
+    ;
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Reporter
+
+=head1 SYNOPSIS
+
+    use FCM::Util::Reporter;
+    $reporter = FCM::Util::Reporter->new({verbosity => $verbosity});
+    $reporter->($message);
+    $reporter->(\@messages);
+    $reporter->(sub {return @some_strings});
+    $reporter->({level => $reporter->MEDIUM}, $message);
+
+=head1 DESCRIPTION
+
+A simple message reporter.
+
+This module is part of L<FCM::Util|FCM::Util>. See also the description of the
+$u->report() method in L<FCM::Util|FCM::Util>.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Returns a new instance of this class, which is a CODE reference. %attrib can
+contain the following:
+
+=over 4
+
+=item ctx_of
+
+A HASH containing a map to the named reporter contexts. At initialisation, a new
+ctx for "stdout" and a new ctx for "stderr" is created automatically.
+
+=back
+
+=item $reporter->add_ctx($key,%option)
+
+Creates a new reporter context, and adds it to the ctx_of HASH, if a context
+with the same $key does not already exist. The %option is given to the
+constructir of L</FCM::Util::Reporter::Context>. Return the context on success.
+
+=item $reporter->del_ctx($key)
+
+Removes a new reporter context named $key. Return the context on success.
+
+=item $reporter->get_ctx($key)
+
+Returns a named reporter context L</FCM::Util::Reporter::Context>.
+
+=item $reporter->get_ctx_of_stderr()
+
+Shorthand for $reporter->get_ctx('stderr').
+
+=item $reporter->get_ctx_of_stdout()
+
+Shorthand for $reporter->get_ctx('stdout').
+
+=item $reporter->report(\%option,$message)
+
+Reports the message. If %option is not given, reports using the default options.
+In the form, the following %options can be specified:
+
+=over 4
+
+=item delimiter
+
+The delimiter of each message in the list. The default is "\n". If the delimiter
+is set to the empty string, the items in $message will be treated as raw
+strings, i.e. it will also ignore any "prefix" options.
+
+=item level
+
+The level of the current message. The default is DEFAULT.
+
+=item prefix
+
+The message prefix. It can be a string or a CODE reference. If it is a string,
+it is simply preprended to the message. If it is a code reference, it is calls
+as $prefix_ref->($option{level}, $option{type}), and its result (if defined) is
+prepended to the message.
+
+=item type
+
+The message type. It can be REPORT_ERR or REPORT_OUT (default).
+
+=back
+
+=back
+
+=head1 CONSTANTS
+
+=over 4
+
+=item $reporter->FAIL, $reporter->QUIET
+
+The verbosity level 0.
+
+=item $reporter->DEFAULT, $reporter->LOW, $reporter->WARN
+
+The verbosity level 1.
+
+=item $reporter->MEDIUM
+
+The verbosity level 2.
+
+=item $reporter->HIGH
+
+The verbosity level 3.
+
+=item $reporter->DEBUG
+
+The verbosity level 4.
+
+=item $reporter->PREFIX_DONE
+
+The prefix for a task "done" message.
+
+=item $reporter->PREFIX_FAIL
+
+The prefix for a fatal error message.
+
+=item $reporter->PREFIX_INFO
+
+The prefix for an "info" message.
+
+=item $reporter->PREFIX_INIT
+
+The prefix for a task "init" message.
+
+=item $reporter->PREFIX_NULL
+
+An empty string.
+
+=item $reporter->PREFIX_QUIT
+
+The prefix for a quit/abort message.
+
+=item $reporter->PREFIX_WARN
+
+The prefix for a warning message.
+
+=item $reporter->REPORT_ERR
+
+The message type for exception message.
+
+=item $reporter->REPORT_OUT
+
+The message type for info message.
+
+=back
+
+=head1 FCM::Util::Reporter::Context
+
+An instance of this class represents the context for a reporter for the
+L<FCM::Util->report()|FCM::Util>. This class is a sub-class of
+L<FCM::Class::HASH|FCM::Class::HASH>. It has the following attributes:
+
+=over 4
+
+=item handle
+
+The file handle for info messages. (Default=\*STDOUT)
+
+=item prefix
+
+The message prefix. It can be a string or a CODE reference. If it is a string,
+it is simply preprended to the message. If it is a code reference, it is calls
+as $prefix_ref->($option{level}, $option{type}), and its result (if defined) is
+prepended to the message. The default is a CODE that returns PREFIX_INFO for
+TYPE_OUT messages, PREFIX_WARN for TYPE_ERR messages at WARN level or above or
+PREFIX_FAIL for TYPE_ERR messages at FAIL level.
+
+=item type
+
+Reporter type. (Default=TYPE_OUT)
+
+=item verbosity
+
+The verbosity of the reporter. Only messages at a level above or equal to the
+verbosity will be reported. The default is DEFAULT.
+
+=back
+
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Shell.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Shell.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/Shell.pm	(revision 5095)
@@ -0,0 +1,306 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM::Util::Shell;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::Event;
+use FCM::Util::Exception;
+use File::Spec::Functions qw{catfile file_name_is_absolute path};
+use IPC::Open3 qw{open3};
+use List::Util qw{first};
+use Scalar::Util qw{reftype};
+use Text::ParseWords qw{shellwords};
+
+our $BUFFER_SIZE = 4096;  # default buffer size
+our $TIME_OUT    = 0.005; # default time out for selecting a file handle
+
+my $E = 'FCM::Util::Exception';
+my %FUNCTION_OF = (e => \&_do_r, i => \&_do_w, o => \&_do_r);
+my @IOE = qw{i o e};
+my %ACTION_FUNC_FOR
+    = (e => \&_action_func_r, i => \&_action_func_w, o => \&_action_func_r);
+
+# Creates the class.
+__PACKAGE__->class(
+    {   buffer_size => {isa => '$', default => $BUFFER_SIZE},
+        time_out    => {isa => '$', default => $TIME_OUT},
+        util        => '&',
+    },
+    {   action_of => {
+            invoke        => \&_invoke,
+            invoke_simple => \&_invoke_simple,
+            which         => \&_which,
+        },
+    },
+);
+
+# Returns a CODE to deal with non-CODE read action.
+sub _action_func_r {
+    my ($arg_ref) = @_;
+    ${$arg_ref} ||= q{};
+    sub {${$arg_ref} .= $_[0]};
+}
+
+# Returns a CODE to deal with non-CODE write action.
+sub _action_func_w {
+    my ($arg_ref) = @_;
+    my @inputs
+        = ref($arg_ref) && reftype($arg_ref) eq 'ARRAY'  ? @{$arg_ref}
+        : ref($arg_ref) && reftype($arg_ref) eq 'SCALAR' ? (${$arg_ref})
+        :                                                  ()
+        ;
+    sub {shift(@inputs)};
+}
+
+# Gets output $value from a selected handle, and invokes $action->($value).
+sub _do_r {
+    my ($attrib_ref, $ctx) = @_;
+    my $n_bytes;
+    while (
+        my @handles = $ctx->get_select()->can_read($attrib_ref->{time_out})
+    ) {
+        my ($handle) = @handles;
+        my $buffer = q{};
+        my $n = sysread($handle, $buffer, $attrib_ref->{buffer_size});
+        if (!defined($n)) {
+            return;
+        }
+        $n_bytes += $n;
+        if ($n == 0) {
+            close($handle) || return;
+            return 0;
+        }
+        $ctx->get_action()->($buffer);
+    }
+    defined($n_bytes) ? $n_bytes : -1;
+}
+
+# Gets input from $action->() and writes to a selected handle if possible.
+# Handles buffering of STDIN to the command.
+sub _do_w {
+    my ($attrib_ref, $ctx) = @_;
+    my $n_bytes;
+    while (
+        my @handles = $ctx->get_select()->can_write($attrib_ref->{time_out})
+    ) {
+        my ($handle) = @handles;
+        if (!$ctx->get_buf()) {
+            $ctx->set_buf($ctx->get_action()->());
+            if (!defined($ctx->get_buf())) {
+                close($handle) || return;
+                return 0;
+            };
+            $ctx->set_buf_length(length($ctx->get_buf()));
+            $ctx->set_buf_offset(0);
+        }
+        my $n = syswrite(
+            $handle,
+            $ctx->get_buf(),
+            $attrib_ref->{buffer_size},
+            $ctx->get_buf_offset(),
+        );
+        if (!defined($n)) {
+            return;
+        }
+        $n_bytes += $n;
+        $ctx->set_buf_offset($ctx->get_buf_offset() + $n);
+        if ($ctx->get_buf_offset() >= $ctx->get_buf_length()) {
+            $ctx->set_buf(undef);
+            $ctx->set_buf_length(0);
+            $ctx->set_buf_offset(0);
+        }
+    }
+    defined($n_bytes) ? $n_bytes : -1;
+}
+
+# Invokes a command.
+sub _invoke {
+    my ($attrib_ref, $command_ref, $action_ref) = @_;
+    # Ensure that the command is an ARRAY
+    if (!ref($command_ref)) {
+        $command_ref = [shellwords($command_ref)];
+    }
+    # Check that the command exists in the PATH
+    if (!_which($attrib_ref, $command_ref->[0])) {
+        return $E->throw($E->SHELL_WHICH, $command_ref);
+    }
+    # Sets up the STDIN, STDOUT and STDERR to the command
+    my %ctx_of = map {($_, FCM::Util::Shell::Context->new())} @IOE;
+    $action_ref ||= {};
+    while (my ($key, $action) = each(%{$action_ref})) {
+        if (exists($ctx_of{$key})) {
+            if (reftype($action) eq 'CODE') {
+                $ctx_of{$key}->set_action($action);
+            }
+            else {
+                $ctx_of{$key}->set_action($ACTION_FUNC_FOR{$key}->($action));
+            }
+        }
+    }
+    # Calls the command with open3
+    my $timer = $attrib_ref->{util}->timer();
+    my $pid = eval {
+        open3((map {$ctx_of{$_}->get_handle()} @IOE), @{$command_ref});
+    };
+    if (my $e = $@) {
+        return $E->throw($E->SHELL_OPEN3, $command_ref, $e);
+    }
+    # Handles input/output of the command
+    for my $ctx (values(%ctx_of)) {
+        $ctx->get_select()->add($ctx->get_handle());
+    }
+    while (keys(%ctx_of)) {
+        while (my ($key, $ctx) = each(%ctx_of)) {
+            my $status = $FUNCTION_OF{$key}->($attrib_ref, $ctx);
+            if (!defined($status)) {
+                return $E->throw($E->SHELL_OS, $command_ref, $!);
+            }
+            if (!$status) {
+                delete($ctx_of{$key});
+            }
+        }
+    }
+    # Wait for command to finish
+    waitpid($pid, 0);
+    my $rc = $?;
+    $attrib_ref->{util}->event(
+        FCM::Context::Event->SHELL, $command_ref, $rc, $timer->(),
+    );
+    # Handles exceptions and signals
+    if ($rc) {
+        if ($rc == -1) {
+            return $E->throw($E->SHELL_OS, $command_ref, $!);
+        }
+        if ($rc & 127) {
+            return $E->throw($E->SHELL_SIGNAL, $command_ref, $rc & 127);
+        }
+    }
+    return $rc >> 8;
+}
+
+# Wraps _invoke.
+sub _invoke_simple {
+    my ($attrib_ref, $command_ref) = @_;
+    my ($e, $o);
+    my $rc = _invoke($attrib_ref, $command_ref, {e => \$e, o => \$o});
+    return {e => $e, o => $o, rc => $rc};
+}
+
+# Returns the full path to the command $name, if it exists in the PATH.
+sub _which {
+    my ($attrib_ref, $name) = @_;
+    if (file_name_is_absolute($name)) {
+        return $name;
+    }
+    use filetest 'access';
+    first {-f $_ && -x _} map {catfile($_, $name)} path();
+    no filetest 'access';
+}
+
+# ------------------------------------------------------------------------------
+package FCM::Util::Shell::Context;
+use base qw{FCM::Class::HASH};
+
+use IO::Select;
+use Symbol qw{gensym};
+
+# A context to hold the information for the command's STDIN, STDOUT or STDERR.
+# action => CODE to call to get more STDIN for the command or to send
+#           STDOUT/STDERR to when possible.
+# buf*   => A buffer (and its length and the current offset) to hold the STDIN
+#           that is yet to be written to the command.
+# handle => The command STDIN, STDOUT or STDERR.
+# select => The IO::Select object that tells us whether the handle is ready for
+#           I/O or not.
+__PACKAGE__->class(
+    {   action     => {isa => '&'},
+        buf        => {isa => '$'},
+        buf_length => {isa => '$'},
+        buf_offset => {isa => '$'},
+        handle     => {isa => '*', default => \&gensym},
+        'select'   => {isa => 'IO::Select', default => sub {IO::Select->new()}},
+    },
+);
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Util::Shell
+
+=head1 SYNOPSIS
+
+    use FCM::Util;
+    $util = FCM::Util->new(\%attrib);
+    %action_of = {e => \&e_handler, i => \&i_handler, o => \&o_handler};
+    $rc = $util->shell(\@command, \%action_of);
+    %value_of = %{$util->shell_simple(\@command)};
+
+=head1 DESCRIPTION
+
+Wraps L<IPC::Open3|IPC::Open3> to provide an interface driven by callbacks.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new(\%attrib)
+
+Returns a new instance. The attributes that can be specified in %attrib are:
+
+=over 4
+
+=item {buffer_size}
+
+The size of the read buffer for reading from the standard output and standard
+error output of the command. The default is 4096.
+
+=item {time_out}
+
+The time to wait when selecting a file handle. The default is 0.001.
+
+=item {util}
+
+A CODE reference. The L<FCM::Util|FCM::Util> object that initialised this
+instance.
+
+=back
+
+=back
+
+See the description of the shell(), shell_simpl() and shell_which() methods in
+L<FCM::Util|FCM::Util> for detail.
+
+=head1 SEE ALSO
+
+L<IPC::Open3|IPC::Open3>
+
+Inspired by the CPAN module L<IPC::Cmd|IPC::Cmd> and friends.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/TaskRunner.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/TaskRunner.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM/Util/TaskRunner.pm	(revision 5095)
@@ -0,0 +1,380 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+# ------------------------------------------------------------------------------
+package FCM::Util::TaskRunner;
+use base qw{FCM::Class::CODE};
+
+my $P = 'FCM::Util::TaskRunner::Parallel';
+my $S = 'FCM::Util::TaskRunner::Serial';
+
+__PACKAGE__->class({util => '&'}, {action_of => {main => \&_main}});
+
+sub _main {
+    my ($attrib_ref, $action_ref, $n_workers) = @_;
+    $n_workers ||= 1;
+    my $class = $n_workers > 1 ? $P : $S;
+    $attrib_ref->{runner} = $class->new({
+        action    => $action_ref,
+        n_workers => $n_workers,
+        util      => $attrib_ref->{util},
+    });
+}
+
+# ------------------------------------------------------------------------------
+package FCM::Util::TaskRunner::Serial;
+use base qw{FCM::Class::CODE};
+
+__PACKAGE__->class(
+    {action => '&', util => '&'},
+    {action_of => {destroy => sub {}, main => \&_main}},
+);
+
+sub _main {
+    my ($attrib_ref, $get_ref, $put_ref) = @_;
+    my $n_done = 0;
+    while (my $task = $get_ref->()) {
+        my $timer = $attrib_ref->{util}->timer();
+        eval {
+            $task->set_state($task->ST_WORKING);
+            $attrib_ref->{action}->($task->get_ctx());
+            $task->set_state($task->ST_OK);
+        };
+        if ($@) {
+            $task->set_error($@);
+            $task->set_state($task->ST_FAILED);
+        }
+        $task->set_elapse($timer->());
+        $put_ref->($task);
+        ++$n_done;
+    }
+    $n_done;
+}
+
+# ------------------------------------------------------------------------------
+package FCM::Util::TaskRunner::Parallel;
+use base qw{FCM::Class::CODE};
+
+use FCM::Context::Event;
+use IO::Select;
+use IO::Socket;
+use List::Util qw{first};
+use POSIX qw{WNOHANG};
+use Socket qw{AF_UNIX SOCK_STREAM PF_UNSPEC};
+use Storable qw{freeze thaw};
+
+# Package name of worker event and state
+my $CTX_EVENT = 'FCM::Context::Event';
+my $CTX_STATE = 'FCM::Util::TaskRunner::WorkerState';
+
+# Length of a packed long integer
+my $LEN_OF_LONG = length(pack('N', 0));
+
+# Time out for polling sockets to child processes
+my $TIME_OUT = 0.05;
+
+# Creates the class.
+__PACKAGE__->class(
+    {   action        => '&',
+        n_workers     => '$',
+        worker_states => '@',
+        util          => '&',
+    },
+    {init => \&_init, action_of => {destroy => \&_destroy, main => \&_main}},
+);
+
+# Destroys the child processes.
+sub _destroy {
+    my $attrib_ref = shift();
+    local($SIG{CHLD}) = 'IGNORE';
+    my $select = IO::Select->new();
+    my @worker_states = @{$attrib_ref->{worker_states}};
+    for my $worker_state (@worker_states) {
+        $select->add($worker_state->get_socket());
+    }
+    # TBD: reads $socket for any left over event etc?
+    for my $socket ($select->can_write(0)) {
+        my $worker_state = first {$_->get_socket() eq $socket} @worker_states;
+        _item_send($socket);
+        close($socket);
+        waitpid($worker_state->get_pid(), 0);
+    }
+    while (waitpid(-1, WNOHANG) > 0) {
+    }
+    $attrib_ref->{util}->event(
+        FCM::Context::Event->TASK_WORKERS, 'destroy', $attrib_ref->{n_workers},
+    );
+    1;
+}
+
+# On initialisation.
+sub _init {
+    my $attrib_ref = shift();
+    for my $i (1 .. $attrib_ref->{n_workers}) {
+        my ($from_boss, $from_worker)
+            = IO::Socket->socketpair(AF_UNIX, SOCK_STREAM, PF_UNSPEC);
+        if (!defined($from_boss) || !defined($from_worker)) {
+            die("socketpair: $!");
+        }
+        $from_worker->autoflush(1);
+        $from_boss->autoflush(1);
+        if (my $pid = fork()) {
+            # I am the boss
+            if ($pid < 0) {
+                die("fork: $!");
+            }
+            local($SIG{CHLD}, $SIG{INT}, $SIG{KILL}, $SIG{TERM}, $SIG{XCPU});
+            for my $key (qw{CHLD INT KILL TERM XCPU}) {
+                local($SIG{$key}) = sub {_destroy($attrib_ref, @_); die($!)};
+            }
+            close($from_worker);
+            push(
+                @{$attrib_ref->{worker_states}},
+                $CTX_STATE->new($pid, $from_boss),
+            );
+        }
+        elsif (defined($pid)) {
+            # I am a worker
+            close($from_boss);
+            $attrib_ref->{worker_states} = [];
+            open(STDIN, '/dev/null');
+            # Ensures that events are sent back to the boss process
+            my $util_of_event = bless(
+                sub {_item_send($from_worker, @_)},
+                __PACKAGE__ . '::WorkerEvent',
+            );
+            no strict 'refs';
+            *{__PACKAGE__ . '::WorkerEvent::main'}
+                = sub {my $self = shift(); $self->(@_)};
+            use strict 'refs';
+            $attrib_ref->{util}->util_of_event($util_of_event);
+            _worker(
+                $from_worker,
+                $attrib_ref->{action},
+                $attrib_ref->{util},
+            );
+            close($from_worker);
+            exit();
+        }
+        else {
+            die("fork: $!");
+        }
+    }
+    $attrib_ref->{util}->event(
+        FCM::Context::Event->TASK_WORKERS, 'init', $attrib_ref->{n_workers},
+    );
+}
+
+# Main function of the class.
+sub _main {
+    my ($attrib_ref, $get_ref, $put_ref) = @_;
+    my $n_done = 0;
+    my $n_wait = 0;
+    my $done_something = 1;
+    my $get_task_ref = _get_task_func($get_ref, $attrib_ref->{n_workers});
+    my $select = IO::Select->new();
+    my @worker_states = @{$attrib_ref->{worker_states}};
+    for my $worker_state (@worker_states) {
+        $select->add($worker_state->get_socket());
+    }
+    while ($n_wait || $done_something) {
+        $done_something = 0;
+        # Handles tasks back from workers
+        while (my @sockets = $select->can_read($TIME_OUT)) {
+            for my $socket (@sockets) {
+                my $worker_state
+                    = first {$socket eq $_->get_socket()} @worker_states;
+                my $item = _item_receive($socket);
+                if (defined($item)) {
+                    $done_something = 1;
+                    if ($item->isa('FCM::Context::Event')) {
+                        # Item is only an event, handles it
+                        $attrib_ref->{util}->event($item);
+                    }
+                    else {
+                        # Sends something back to the worker immediately
+                        if (defined(my $task = $get_task_ref->())) {
+                            _item_send($socket, $task);
+                        }
+                        else {
+                            --$n_wait;
+                            $worker_state->set_idle(1);
+                        }
+                        $put_ref->($item);
+                        ++$n_done;
+                    }
+                }
+            }
+        }
+        # Sends something to the idle workers
+        my @idle_worker_states = grep {$_->get_idle()} @worker_states;
+        if (@idle_worker_states) {
+            for my $worker_state (@idle_worker_states) {
+                if (defined(my $task = $get_task_ref->())) {
+                    _item_send($worker_state->get_socket(), $task);
+                    ++$n_wait;
+                    $done_something = 1;
+                    $worker_state->set_idle(0);
+                }
+            }
+        }
+        else {
+            $get_task_ref->(); # only adds more tasks to queue
+        }
+    }
+    $n_done;
+}
+
+# Returns a function to fetch more tasks into a queue.
+sub _get_task_func {
+    my ($get_ref, $n_workers) = @_;
+    my $max_n_in_queue = $n_workers * 2;
+    my @queue;
+    sub {
+        while (@queue < $max_n_in_queue && defined(my $task = $get_ref->())) {
+            push(@queue, $task);
+        }
+        if (!defined(wantarray())) {
+            return;
+        }
+        shift(@queue);
+    };
+}
+
+# Receives an item from a socket.
+sub _item_receive {
+    my ($socket) = @_;
+    my $len_of_data = unpack('N', _item_travel($socket, $LEN_OF_LONG));
+    $len_of_data ? thaw(_item_travel($socket, $len_of_data)) : undef;
+}
+
+# Sends an item to a socket.
+sub _item_send {
+    my ($socket, $item) = @_;
+    my $item_as_data = $item ? freeze($item) : q{};
+    my $message = pack('N', length($item_as_data)) . $item_as_data;
+    _item_travel($socket, length($message), $message);
+}
+
+# Helper for _item_receive/_item_send.
+sub _item_travel {
+    my ($socket, $len_to_travel, $data) = @_;
+    my $action
+        = defined($data) ? sub {syswrite($socket, $data, $_[0], $_[1])}
+        :                  sub {sysread( $socket, $data, $_[0], $_[1])}
+        ;
+    $data ||= q{};
+    my $n_bytes = 0;
+    while ($n_bytes < $len_to_travel) {
+        my $len_remain = $len_to_travel - $n_bytes;
+        my $n = $action->($len_remain, $n_bytes);
+        if (!defined($n)) {
+            die($!);
+        }
+        $n_bytes += $n;
+    }
+    $data;
+}
+
+# Performs the function of a worker. Receives a task. Actions it. Sends it back.
+sub _worker {
+    my ($socket, $action, $util) = @_;
+    while (defined(my $task = _item_receive($socket))) {
+        my $timer = $util->timer();
+        eval {
+            $task->set_state($task->ST_WORKING);
+            $action->($task->get_ctx());
+            $task->set_state($task->ST_OK);
+        };
+        if ($@) {
+            $task->set_state($task->ST_FAILED);
+            $task->set_error($@);
+        }
+        $task->set_elapse($timer->());
+        _item_send($socket, $task);
+    }
+    1;
+}
+
+# ------------------------------------------------------------------------------
+# The state of a worker.
+package FCM::Util::TaskRunner::WorkerState;
+use base qw{FCM::Class::HASH};
+
+__PACKAGE__->class(
+    {   'idle'   => {isa => '$', default => 1}, # worker is idle?
+        'pid'    => '$',                        # worker's PID
+        'socket' => '*',                        # socket to worker
+    },
+    {   init_attrib => sub {
+            my ($pid, $socket) = @_;
+            {'pid' => $pid, 'socket' => $socket};
+        },
+    },
+);
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM::Util::TaskRunner
+
+=head1 SYNOPSIS
+
+    use FCM::Context::Task;
+    use FCM::Util;
+    my $util = FCM::Util->new(\%attrib);
+    # ... time passes
+    my $runner = $util->task_runner(\&do_task, 4); # run with 4 workers
+    # ... time passes
+    my $get_ref = sub {
+        # ... an iterator to return an FCM::Context::Task object
+        # one at a time, returns undef if there is no currently available task
+    };
+    my $put_ref = sub {
+        my ($task) = @_;
+        # ... callback at end of each task
+    };
+    my $n_done = $runner->main($get_ref, $put_ref);
+
+=head1 DESCRIPTION
+
+This module is part of L<FCM::Util|FCM::Util>. See the description of the
+task_runner() method for details.
+
+An instance of this class is a runner of tasks. It can be configured to work in
+serial (default) or parallel. The class is a sub-class of
+L<FCM::Class::CODE|FCM::Class::CODE>.
+
+=head1 SEE ALSO
+
+This module is inspired by the CPAN modules Parallel::Fork::BossWorker and
+Parallel::Fork::BossWorkerAsync.
+
+L<FCM::Context::Task|FCM::Context::Task>,
+L<FCM::Util::TaskManager|FCM::Util::TaskManager>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Base.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Base.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Base.pm	(revision 5095)
@@ -0,0 +1,125 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::Base
+#
+# DESCRIPTION
+#   This is base class for all FCM OO packages.
+#
+# ------------------------------------------------------------------------------
+
+package FCM1::Base;
+
+# Standard pragma
+use strict;
+use warnings;
+
+use FCM1::Config;
+
+my @scalar_properties = (
+  'config', # instance of FCM1::Config, configuration setting
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::Base->new;
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::Base class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self  = {};
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'config') {
+        # Configuration setting of the main program
+        $self->{$name} = FCM1::Config->instance();
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $self->setting (@args); # $self->config->setting
+#   $value = $self->verbose (@args); # $self->config->verbose
+# ------------------------------------------------------------------------------
+
+for my $name (qw/setting verbose/) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+    return $self->config->$name (@_);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $self->cfglabel (@args);
+#
+# DESCRIPTION
+#   This is an alias to $self->config->setting ('CFG_LABEL', @args);
+# ------------------------------------------------------------------------------
+
+sub cfglabel {
+  my $self = shift;
+  return $self->setting ('CFG_LABEL', @_);
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Build.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Build.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Build.pm	(revision 5095)
@@ -0,0 +1,1630 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::Build
+#
+# DESCRIPTION
+#   This is the top level class for the FCM build system.
+#
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package FCM1::Build;
+use base qw(FCM1::ConfigSystem);
+
+use Carp             qw{croak}                                       ;
+use Cwd              qw{cwd}                                         ;
+use FCM1::BuildSrc                                                   ;
+use FCM1::BuildTask                                                  ;
+use FCM1::Config                                                     ;
+use FCM1::Dest                                                       ;
+use FCM1::CfgLine                                                    ;
+use FCM1::Timer      qw{timestamp_command}                           ;
+use FCM1::Util       qw{expand_tilde run_command touch_file w_report};
+use File::Basename   qw{dirname}                                     ;
+use File::Spec                                                       ;
+use List::Util       qw{first}                                       ;
+use Text::ParseWords qw{shellwords}                                  ;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+  'name',    # name of this build
+  'target',  # targets of this build
+);
+
+# List of hash property methods for this class
+my @hash_properties = (
+  'srcpkg',      # source packages of this build
+  'dummysrcpkg', # dummy for handling package inheritance with file extension
+);
+
+# List of compare_setting_X methods
+my @compare_setting_methods = (
+  'compare_setting_bld_blockdata', # program executable blockdata dependency
+  'compare_setting_bld_dep',       # custom dependency setting
+  'compare_setting_bld_dep_excl',  # exclude dependency setting
+  'compare_setting_bld_dep_n',     # no dependency check
+  'compare_setting_bld_dep_pp',    # custom PP dependency setting
+  'compare_setting_bld_dep_exe',   # program executable extra dependency
+  'compare_setting_bld_exe_name',  # program executable rename
+  'compare_setting_bld_pp',        # PP flags
+  'compare_setting_infile_ext',    # input file extension
+  'compare_setting_outfile_ext',   # output file extension
+  'compare_setting_tool',          # build tool settings
+);
+
+my $DELIMITER_LIST = $FCM1::Config::DELIMITER_LIST;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::Build->new;
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::Build class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = FCM1::ConfigSystem->new (%args);
+
+  $self->{$_} = undef for (@scalar_properties);
+
+  $self->{$_} = {} for (@hash_properties);
+
+  bless $self, $class;
+
+  # List of sub-methods for parse_cfg
+  push @{ $self->cfg_methods }, (qw/target source tool dep misc/);
+
+  # Optional prefix in configuration declaration
+  $self->cfg_prefix ($self->setting (qw/CFG_LABEL BDECLARE/));
+
+  # System type
+  $self->type ('bld');
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'target') {
+        # Reference to an array
+        $self->{$name} = [];
+
+      } elsif ($name eq 'name') {
+        # Empty string
+        $self->{$name} = '';
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @hash_properties.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (@hash_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    $self->{$name} = {} if not defined ($self->{$name});
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $new_lines) = $self->X ($old_lines);
+#
+# DESCRIPTION
+#   This method compares current settings with those in the cache, where X is
+#   one of @compare_setting_methods.
+#
+#   If setting has changed:
+#   * For bld_blockdata, bld_dep_ext and bld_exe_name, it sets the re-generate
+#     make-rule flag to true.
+#   * For bld_dep_excl, in a standalone build, the method will remove the
+#     dependency cache files for affected sub-packages. It returns an error if
+#     the current build inherits from previous builds.
+#   * For bld_pp, it updates the PP setting for affected sub-packages.
+#   * For infile_ext, in a standalone build, the method will remove all the
+#     sub-package cache files and trigger a re-build by removing most
+#     sub-directories created by the previous build. It returns an error if the
+#     current build inherits from previous builds.
+#   * For outfile_ext, in a standalone build, the method will remove all the
+#     sub-package dependency cache files. It returns an error if the current
+#     build inherits from previous builds.
+#   * For tool, it updates the "flags" files for any changed tools.
+# ------------------------------------------------------------------------------
+
+for my $name (@compare_setting_methods) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $old_lines) = @_;
+
+    (my $prefix = uc ($name)) =~ s/^COMPARE_SETTING_//;
+
+    my ($changed, $new_lines) =
+      $self->compare_setting_in_config ($prefix, $old_lines);
+
+    my $rc = scalar (keys %$changed);
+
+    if ($rc and $old_lines) {
+      $self->srcpkg ('')->is_updated (1);
+
+      if ($name =~ /^compare_setting_bld_dep(?:_excl|_n|_pp)?$/) {
+        # Mark affected packages as being updated
+        for my $key (keys %$changed) {
+          for my $pkg (values %{ $self->srcpkg }) {
+            next unless $pkg->is_in_package ($key);
+            $pkg->is_updated (1);
+          }
+        }
+
+      } elsif ($name eq 'compare_setting_bld_pp') {
+        # Mark affected packages as being updated
+        for my $key (keys %$changed) {
+          for my $pkg (values %{ $self->srcpkg }) {
+            next unless $pkg->is_in_package ($key);
+            next unless $self->srcpkg ($key)->is_type_any (
+              keys %{ $self->setting ('BLD_TYPE_DEP_PP') }
+            ); # Is a type requiring pre-processing
+
+            $pkg->is_updated (1);
+          }
+        }
+
+      } elsif ($name eq 'compare_setting_infile_ext') {
+        # Re-set input file type if necessary
+        for my $key (keys %$changed) {
+          for my $pkg (values %{ $self->srcpkg }) {
+            next unless $pkg->src and $pkg->ext and $key eq $pkg->ext;
+
+            $pkg->type (undef);
+          }
+        }
+
+        # Mark affected packages as being updated
+        for my $pkg (values %{ $self->srcpkg }) {
+          $pkg->is_updated (1);
+        }
+
+      } elsif ($name eq 'compare_setting_outfile_ext') {
+        # Mark affected packages as being updated
+        for my $pkg (values %{ $self->srcpkg }) {
+          $pkg->is_updated (1);
+        }
+
+      } elsif ($name eq 'compare_setting_tool') {
+        # Update the "flags" files for changed tools
+        for my $name (sort keys %$changed) {
+          my ($tool, @names) = split /__/, $name;
+          my $pkg  = join ('__', @names);
+          my @srcpkgs
+            = $self->srcpkg($pkg)      ? ($self->srcpkg($pkg))
+            : $self->dummysrcpkg($pkg) ? @{$self->dummysrcpkg($pkg)->children()}
+            :                            ()
+            ;
+          for my $srcpkg (@srcpkgs) {
+            my $file = File::Spec->catfile (
+              $self->dest->flagsdir, $srcpkg->flagsbase ($tool)
+            );
+            &touch_file ($file) or croak $file, ': cannot update, abort';
+
+            print $file, ': updated', "\n" if $self->verbose > 2;
+          }
+        }
+      }
+    }
+
+    return ($rc, $new_lines);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $new_lines) = $self->compare_setting_dependency ($old_lines, $flag);
+#
+# DESCRIPTION
+#   This method uses the previous settings to determine the dependencies of
+#   current source files.
+# ------------------------------------------------------------------------------
+
+sub compare_setting_dependency {
+  my ($self, $old_lines, $flag) = @_;
+
+  my $prefix = $flag ? 'DEP_PP' : 'DEP';
+  my $method = $flag ? 'ppdep'  : 'dep';
+
+  my $rc = 0;
+  my $new_lines = [];
+
+  # Separate old lines
+  my %old;
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      next unless $line->label_starts_with ($prefix);
+      $old{$line->label_from_field (1)} = $line;
+    }
+  }
+
+  # Go through each source to see if the cache is up to date
+  my $count = 0;
+  my %mtime;
+  for my $srcpkg (values %{ $self->srcpkg }) {
+    next unless $srcpkg->cursrc and $srcpkg->type;
+
+    my $key = $srcpkg->pkgname;
+    my $out_of_date = $srcpkg->is_updated;
+
+    # Check modification time of cache and source file if not out of date
+    if (exists $old{$key}) {
+      if (not $out_of_date) {
+        $mtime{$old{$key}->src} = (stat ($old{$key}->src))[9]
+          if not exists ($mtime{$old{$key}->src});
+
+        $out_of_date = 1 if $mtime{$old{$key}->src} < $srcpkg->curmtime;
+      }
+    }
+    else {
+      $out_of_date = 1;
+    }
+
+    if ($out_of_date) {
+      # Re-scan dependency
+      $srcpkg->is_updated(1);
+      my ($source_is_read, $dep_hash_ref) = $srcpkg->get_dep($flag);
+      if ($source_is_read) {
+        $count++;
+      }
+      $srcpkg->$method($dep_hash_ref);
+      $rc = 1;
+    }
+    else {
+      # Use cached dependency
+      my ($progname, %hash) = split (
+        /$FCM1::Config::DELIMITER_PATTERN/, $old{$key}->value
+      );
+      $srcpkg->progname ($progname) if $progname and not $flag;
+      $srcpkg->$method (\%hash);
+    }
+
+    # New lines values: progname[::dependency-name::type][...]
+    my @value = ((defined $srcpkg->progname ? $srcpkg->progname : ''));
+    for my $name (sort keys %{ $srcpkg->$method }) {
+      push @value, $name, $srcpkg->$method ($name);
+    }
+
+    push @$new_lines, FCM1::CfgLine->new (
+      LABEL => $prefix . $FCM1::Config::DELIMITER . $key,
+      VALUE => join ($FCM1::Config::DELIMITER, @value),
+    );
+  }
+
+  print 'No. of file', ($count > 1 ? 's' : ''), ' scanned for',
+        ($flag ? ' PP': ''), ' dependency: ', $count, "\n"
+    if $self->verbose and $count;
+
+  return ($rc, $new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $new_lines) = $self->compare_setting_srcpkg ($old_lines);
+#
+# DESCRIPTION
+#   This method uses the previous settings to determine the type of current
+#   source files.
+# ------------------------------------------------------------------------------
+
+sub compare_setting_srcpkg {
+  my ($self, $old_lines) = @_;
+
+  my $prefix = 'SRCPKG';
+
+  # Get relevant items from old lines, stripping out $prefix
+  my %old;
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      next unless $line->label_starts_with ($prefix);
+      $old{$line->label_from_field (1)} = $line;
+    }
+  }
+
+  # Check for change, use previous setting if exist
+  my $out_of_date = 0;
+  my %mtime;
+  for my $key (keys %{ $self->srcpkg }) {
+    if (exists $old{$key}) {
+      next unless $self->srcpkg ($key)->cursrc;
+
+      my $type = defined $self->setting ('BLD_TYPE', $key)
+                 ? $self->setting ('BLD_TYPE', $key) : $old{$key}->value;
+
+      $self->srcpkg ($key)->type ($type);
+
+      if ($type ne $old{$key}->value) {
+        $self->srcpkg ($key)->is_updated (1);
+        $out_of_date = 1;
+      }
+
+      if (not $self->srcpkg ($key)->is_updated) {
+        $mtime{$old{$key}->src} = (stat ($old{$key}->src))[9]
+          if not exists ($mtime{$old{$key}->src});
+
+        $self->srcpkg ($key)->is_updated (1)
+          if $mtime{$old{$key}->src} < $self->srcpkg ($key)->curmtime;
+      }
+
+    } else {
+      $self->srcpkg ($key)->is_updated (1);
+      $out_of_date = 1;
+    }
+  }
+
+  # Check for deleted keys
+  for my $key (keys %old) {
+    next if $self->srcpkg ($key);
+
+    $out_of_date = 1;
+  }
+
+  # Return reference to an array of new lines
+  my $new_lines = [];
+  for my $key (keys %{ $self->srcpkg }) {
+    push @$new_lines, FCM1::CfgLine->new (
+      LABEL => $prefix . $FCM1::Config::DELIMITER . $key,
+      VALUE => $self->srcpkg ($key)->type,
+    );
+  }
+
+  return ($out_of_date, $new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $new_lines) = $self->compare_setting_target ($old_lines);
+#
+# DESCRIPTION
+#   This method compare the previous target settings with current ones.
+# ------------------------------------------------------------------------------
+
+sub compare_setting_target {
+  my ($self, $old_lines) = @_;
+
+  my $prefix = 'TARGET';
+  my $old;
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      next unless $line->label_starts_with ($prefix);
+      $old = $line->value;
+      last;
+    }
+  }
+
+  my $new = join (' ', sort @{ $self->target });
+
+  return (
+    (defined ($old) ? $old ne $new : 1),
+    [FCM1::CfgLine->new (LABEL => $prefix, VALUE => $new)],
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_fortran_interface_generator ();
+#
+# DESCRIPTION
+#   This method invokes the Fortran interface generator for all Fortran free
+#   format source files. It returns true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_fortran_interface_generator {
+  my $self = shift;
+
+  my $pdoneext = $self->setting (qw/OUTFILE_EXT PDONE/);
+
+  # Set up build task to generate interface files for all selected Fortran 9x
+  # sources
+  my %task = ();
+  SRC_FILE:
+  for my $srcfile (values %{ $self->srcpkg }) {
+    if (!defined($srcfile->interfacebase())) {
+      next SRC_FILE;
+    }
+    my $target  = $srcfile->interfacebase . $pdoneext;
+
+    $task{$target} = FCM1::BuildTask->new (
+      TARGET     => $target,
+      TARGETPATH => $self->dest->donepath,
+      SRCFILE    => $srcfile,
+      DEPENDENCY => [$srcfile->flagsbase ('GENINTERFACE')],
+      ACTIONTYPE => 'GENINTERFACE',
+    );
+
+    # Set up build tasks for each source file/package flags file for interface
+    # generator tool
+    for my $i (1 .. @{ $srcfile->pkgnames }) {
+      my $target = $srcfile->flagsbase ('GENINTERFACE', -$i);
+      my $depend = $i < @{ $srcfile->pkgnames }
+                   ? $srcfile->flagsbase ('GENINTERFACE', -$i - 1)
+                   : undef;
+
+      $task{$target} = FCM1::BuildTask->new (
+        TARGET     => $target,
+        TARGETPATH => $self->dest->flagspath,
+        DEPENDENCY => [defined ($depend) ? $depend : ()],
+        ACTIONTYPE => 'UPDATE',
+      ) if not exists $task{$target};
+    }
+  }
+
+  # Set up build task to update the flags file for interface generator tool
+  $task{$self->srcpkg ('')->flagsbase ('GENINTERFACE')} = FCM1::BuildTask->new (
+    TARGET     => $self->srcpkg ('')->flagsbase ('GENINTERFACE'),
+    TARGETPATH => $self->dest->flagspath,
+    ACTIONTYPE => 'UPDATE',
+  );
+
+  my $count = 0;
+
+  # Performs task
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'GENINTERFACE';
+
+    my $rc = $task->action (TASKLIST => \%task);
+    $count++ if $rc;
+  }
+
+  print 'No. of generated Fortran interface', ($count > 1 ? 's' : ''), ': ',
+        $count, "\n"
+    if $self->verbose and $count;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_make (%args);
+#
+# DESCRIPTION
+#   This method invokes the make stage of the build system. It returns true on
+#   success.
+#
+# ARGUMENTS
+#   ARCHIVE - If set to "true", invoke the "archive" mode. Most build files and
+#             directories created by this build will be archived using the
+#             "tar" command.  If not set, the default is not to invoke the
+#             "archive" mode.
+#   JOBS    - Specify number of jobs that can be handled by "make". If set, the
+#             value must be a natural integer. If not set, the default value is
+#             1 (i.e.  run "make" in serial mode).
+#   TARGETS - Specify targets to be built. If set, these targets will be built
+#             instead of the ones specified in the build configuration file.
+# ------------------------------------------------------------------------------
+
+sub invoke_make {
+  my ($self, %args) = @_;
+  $args{TARGETS} ||= ['all'];
+  $args{JOBS}    ||= 1;
+  my @command = (
+    $self->setting(qw/TOOL MAKE/),
+    shellwords($self->setting(qw/TOOL MAKEFLAGS/)),
+    # -f Makefile
+    ($self->setting(qw/TOOL MAKE_FILE/), $self->dest()->bldmakefile()),
+    # -j N
+    ($args{JOBS} ? ($self->setting(qw/TOOL MAKE_JOB/), $args{JOBS}) : ()),
+    # -s
+    ($self->verbose() < 3 ? $self->setting(qw/TOOL MAKE_SILENT/) : ()),
+    @{$args{TARGETS}}
+  );
+  my $old_cwd = $self->_chdir($self->dest()->rootdir());
+  run_command(
+    \@command, ERROR => 'warn', RC => \my($code), TIME => $self->verbose() >= 3,
+  );
+  $self->_chdir($old_cwd);
+
+  my $rc = !$code;
+  if ($rc && $args{ARCHIVE}) {
+    $rc = $self->dest()->archive();
+  }
+  $rc &&= $self->dest()->create_bldrunenvsh();
+  while (my ($key, $source) = each(%{$self->srcpkg()})) {
+    $rc &&= defined($source->write_lib_dep_excl());
+  }
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_pre_process ();
+#
+# DESCRIPTION
+#   This method invokes the pre-process stage of the build system. It
+#   returns true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_pre_process {
+  my $self = shift;
+   
+  # Check whether pre-processing is necessary
+  my $invoke = 0;
+  for (values %{ $self->srcpkg }) {
+    next unless $_->get_setting ('BLD_PP');
+    $invoke = 1;
+    last;
+  }
+  return 1 unless $invoke;
+
+  # Scan header dependency
+  my $rc = $self->compare_setting (
+    METHOD_LIST => ['compare_setting_dependency'],
+    METHOD_ARGS => ['BLD_TYPE_DEP_PP'],
+    CACHEBASE   => $self->setting ('CACHE_DEP_PP'),
+  );
+
+  return $rc if not $rc;
+
+  my %task     = ();
+  my $pdoneext = $self->setting (qw/OUTFILE_EXT PDONE/);
+
+  # Set up tasks for each source file
+  for my $srcfile (values %{ $self->srcpkg }) {
+    if ($srcfile->is_type_all (qw/CPP INCLUDE/)) {
+      # Set up a copy build task for each include file
+      $task{$srcfile->base} = FCM1::BuildTask->new (
+        TARGET     => $srcfile->base,
+        TARGETPATH => $self->dest->incpath,
+        SRCFILE    => $srcfile,
+        DEPENDENCY => [keys %{ $srcfile->ppdep }],
+        ACTIONTYPE => 'COPY',
+      );
+
+    } elsif ($srcfile->lang ('TOOL_SRC_PP')) {
+      next unless $srcfile->get_setting ('BLD_PP');
+
+      # Set up a PP build task for each source file
+      my $target = $srcfile->base . $pdoneext;
+
+      # Issue warning for duplicated tasks
+      if (exists $task{$target}) {
+        w_report 'WARNING: ', $target, ': unable to create task for: ',
+                 $srcfile->src, ': task already exists for: ',
+                 $task{$target}->srcfile->src;
+        next;
+      }
+
+      $task{$target} = FCM1::BuildTask->new (
+        TARGET     => $target,
+        TARGETPATH => $self->dest->donepath,
+        SRCFILE    => $srcfile,
+        DEPENDENCY => [$srcfile->flagsbase ('PPKEYS'), keys %{ $srcfile->ppdep }],
+        ACTIONTYPE => 'PP',
+      );
+
+      # Set up update ppkeys/flags build tasks for each source file/package
+      my $ppkeys = $self->setting (
+        'TOOL_SRC_PP', $srcfile->lang ('TOOL_SRC_PP'), 'PPKEYS'
+      );
+
+      for my $i (1 .. @{ $srcfile->pkgnames }) {
+        my $target = $srcfile->flagsbase ($ppkeys, -$i);
+        my $depend = $i < @{ $srcfile->pkgnames }
+                     ? $srcfile->flagsbase ($ppkeys, -$i - 1)
+                     : undef;
+
+        $task{$target} = FCM1::BuildTask->new (
+          TARGET     => $target,
+          TARGETPATH => $self->dest->flagspath,
+          DEPENDENCY => [defined ($depend) ? $depend : ()],
+          ACTIONTYPE => 'UPDATE',
+        ) if not exists $task{$target};
+      }
+    }
+  }
+
+  # Set up update global ppkeys build tasks
+  for my $lang (keys %{ $self->setting ('TOOL_SRC_PP') }) {
+    my $target = $self->srcpkg ('')->flagsbase (
+      $self->setting ('TOOL_SRC_PP', $lang, 'PPKEYS')
+    );
+
+    $task{$target} = FCM1::BuildTask->new (
+      TARGET     => $target,
+      TARGETPATH => $self->dest->flagspath,
+      ACTIONTYPE => 'UPDATE',
+    );
+  }
+
+  # Build all PP tasks
+  my $count = 0;
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'PP';
+
+    my $rc = $task->action (TASKLIST => \%task);
+    $task->srcfile->is_updated ($rc);
+    $count++ if $rc;
+  }
+
+  print 'No. of pre-processed file', ($count > 1 ? 's' : ''), ': ', $count, "\n"
+    if $self->verbose and $count;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_scan_dependency ();
+#
+# DESCRIPTION
+#   This method invokes the scan dependency stage of the build system. It
+#   returns true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_scan_dependency {
+  my $self = shift;
+
+  # Scan/retrieve dependency
+  # ----------------------------------------------------------------------------
+  my $rc = $self->compare_setting (
+    METHOD_LIST => ['compare_setting_dependency'],
+    CACHEBASE   => $self->setting ('CACHE_DEP'),
+  );
+
+  # Check whether make file is out of date
+  # ----------------------------------------------------------------------------
+  my $out_of_date = ! -f $self->dest->bldmakefile;
+
+  if ($rc and not $out_of_date) {
+    for (qw/CACHE CACHE_DEP/) {
+      my $cache_mtime = (stat (File::Spec->catfile (
+        $self->dest->cachedir, $self->setting ($_),
+      )))[9];
+      my $mfile_mtime = (stat ($self->dest->bldmakefile))[9];
+
+      next if not defined $cache_mtime;
+      next if $cache_mtime < $mfile_mtime;
+      $out_of_date = 1;
+      last;
+    }
+  }
+
+  if ($rc and not $out_of_date) {
+    for (values %{ $self->srcpkg }) {
+      next unless $_->is_updated;
+      $out_of_date = 1;
+      last;
+    }
+  }
+
+  if ($rc and $out_of_date) {
+    # Write Makefile
+    # --------------------------------------------------------------------------
+    # Register non-word package name
+    my $unusual = 0;
+    for my $key (sort keys %{ $self->srcpkg }) {
+      next if $self->srcpkg ($key)->src;
+      next if $key =~ /^\w*$/;
+
+      $self->setting (
+        ['FCM_PCK_OBJECTS', $key], 'FCM_PCK_OBJECTS' . $unusual++,
+      );
+    }
+
+    # Write different parts in the Makefile
+    my $makefile = '# Automatic Makefile' . "\n\n";
+    $makefile .= 'FCM_BLD_NAME = ' . $self->name . "\n" if $self->name;
+    $makefile .= 'FCM_BLD_CFG = ' . $self->cfg->actual_src . "\n";
+    $makefile .= 'export FCM_VERBOSE ?= ' . $self->verbose . "\n\n";
+    $makefile .= "export OBJECTS\n";
+    $makefile .= $self->dest->write_rules;
+    $makefile .= $self->_write_makefile_perl5lib;
+    $makefile .= $self->_write_makefile_tool;
+    $makefile .= $self->_write_makefile_vpath;
+    $makefile .= $self->_write_makefile_target;
+
+    # Write rules for each source package
+    # Ensure that container packages come before files - this allows $(OBJECTS)
+    # and its dependent variables to expand correctly
+    my @srcpkg = sort {
+      if ($self->srcpkg ($a)->libbase and $self->srcpkg ($b)->libbase) {
+        $b cmp $a;
+
+      } elsif ($self->srcpkg ($a)->libbase) {
+        -1;
+
+      } elsif ($self->srcpkg ($b)->libbase) {
+        1;
+
+      } else {
+        $a cmp $b;
+      }
+    } keys %{ $self->srcpkg };
+
+    for (@srcpkg) {
+      $makefile .= $self->srcpkg ($_)->write_rules if $self->srcpkg ($_)->rules;
+    }
+    $makefile .= '# EOF' . "\n";
+
+    # Update Makefile
+    open OUT, '>', $self->dest->bldmakefile
+      or croak $self->dest->bldmakefile, ': cannot open (', $!, '), abort';
+    print OUT $makefile;
+    close OUT
+      or croak $self->dest->bldmakefile, ': cannot close (', $!, '), abort';
+
+    print $self->dest->bldmakefile, ': updated', "\n" if $self->verbose;
+
+    # Check for duplicated targets
+    # --------------------------------------------------------------------------
+    # Get list of types that cannot have duplicated targets
+    my @no_duplicated_target_types = split (
+      /$DELIMITER_LIST/,
+      $self->setting ('BLD_TYPE_NO_DUPLICATED_TARGET'),
+    );
+
+    my %targets;
+    for my $name (sort keys %{ $self->srcpkg }) {
+      next unless $self->srcpkg ($name)->rules;
+
+      for my $key (sort keys %{ $self->srcpkg ($name)->rules }) {
+        if (exists $targets{$key}) {
+          # Duplicated target: warning for most file types
+          my $status = 'WARNING';
+
+          # Duplicated target: error for the following file types
+          if (@no_duplicated_target_types and
+              $self->srcpkg ($name)->is_type_any (@no_duplicated_target_types) and
+              $targets{$key}->is_type_any (@no_duplicated_target_types)) {
+            $status = 'ERROR';
+            $rc = 0;
+          }
+
+          # Report the warning/error
+          w_report $status, ': ', $key, ': duplicated targets for building:';
+          w_report '       ', $targets{$key}->src;
+          w_report '       ', $self->srcpkg ($name)->src;
+
+        } else {
+          $targets{$key} = $self->srcpkg ($name);
+        }
+      }
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_setup_build ();
+#
+# DESCRIPTION
+#   This method invokes the setup_build stage of the build system. It returns
+#   true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_setup_build {
+  my $self = shift;
+
+  my $rc = 1;
+
+  # Extract archived sub-directories if necessary
+  $rc = $self->dest->dearchive if $rc;
+
+  # Compare cache
+  $rc = $self->compare_setting (METHOD_LIST => [
+    'compare_setting_target', # targets
+    'compare_setting_srcpkg', # source package type
+    @compare_setting_methods,
+  ]) if $rc;
+
+  # Set up runtime dependency scan patterns
+  my %dep_pattern = %{ $self->setting ('BLD_DEP_PATTERN') };
+  for my $key (keys %dep_pattern) {
+    my $pattern = $dep_pattern{$key};
+
+    while ($pattern =~ /##([\w:]+)##/g) {
+      my $match = $1;
+      my $val   = $self->setting (split (/$FCM1::Config::DELIMITER/, $match));
+
+      last unless defined $val;
+      $val =~ s/\./\\./;
+
+      $pattern =~ s/##$match##/$val/;
+    }
+
+    $self->setting (['BLD_DEP_PATTERN', $key], $pattern)
+      unless $pattern eq $dep_pattern{$key};
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_system (%args);
+#
+# DESCRIPTION
+#   This method invokes the build system. It returns true on success. See also
+#   the header for invoke_make for further information on arguments.
+#
+# ARGUMENTS
+#   STAGE - If set, it should be an integer number or a recognised keyword or
+#           abbreviation. If set, the build is performed up to the named stage.
+#           If not set, the default is to perform all stages of the build.
+#           Allowed values are:
+#             1, setup or s
+#             2, pre_process or pp
+#             3, generate_dependency or gd
+#             4, generate_interface or gi
+#             5, all, a, make or m
+# ------------------------------------------------------------------------------
+
+sub invoke_system {
+  my $self = shift;
+  my %args = @_;
+
+  # Parse arguments
+  # ----------------------------------------------------------------------------
+  # Default: run all 5 stages
+  my $stage = (exists $args{STAGE} and $args{STAGE}) ? $args{STAGE} : 5;
+
+  # Resolve named stages
+  if ($stage !~ /^\d$/) {
+    my %stagenames = (
+      'S(?:ETUP)?'                      => 1,
+      'P(?:RE)?_?P(?:ROCESS)?'          => 2,
+      'G(?:ENERATE)?_?D(?:ENPENDENCY)?' => 3,
+      'G(?:ENERATE)?_?I(?:NTERFACE)?'   => 4,
+      '(?:A(?:LL)|M(?:AKE)?)'           => 5,
+    );
+
+    # Does it match a recognised stage?
+    for my $name (keys %stagenames) {
+      next unless $stage =~ /$name/i;
+
+      $stage = $stagenames{$name};
+      last;
+    }
+
+    # Specified stage name not recognised, default to 5
+    if ($stage !~ /^\d$/) {
+      w_report 'WARNING: ', $stage, ': invalid build stage, default to 5.';
+      $stage = 5;
+    }
+  }
+
+  # Run the method associated with each stage
+  # ----------------------------------------------------------------------------
+  my $rc = 1;
+
+  my @stages = (
+    ['Setup build'               , 'invoke_setup_build'],
+    ['Pre-process'               , 'invoke_pre_process'],
+    ['Scan dependency'           , 'invoke_scan_dependency'],
+    ['Generate Fortran interface', 'invoke_fortran_interface_generator'],
+    ['Make'                      , 'invoke_make'],
+  );
+
+  for my $i (1 .. 5) {
+    last if (not $rc) or $i > $stage;
+
+    my ($name, $method) = @{ $stages[$i - 1] };
+    $rc = $self->invoke_stage ($name, $method, %args) if $rc and $stage >= $i;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_dep (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the dependency settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_dep {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc = 1;
+
+  # EXCL_DEP, EXE_DEP and BLOCKDATA declarations
+  # ----------------------------------------------------------------------------
+  for my $name (qw/BLD_BLOCKDATA BLD_DEP BLD_DEP_EXCL BLD_DEP_EXE/) {
+    for my $line (grep {$_->slabel_starts_with_cfg ($name)} @$cfg_lines) {
+      # Separate label into a list, delimited by double-colon, remove 1st field
+      my @flds = $line->slabel_fields;
+      shift @flds;
+
+      if ($name =~ /^(?:BLD_DEP|BLD_DEP_EXCL|BLD_DEP_PP)$/) {
+        # BLD_DEP_*: label fields may contain sub-package
+        my $pk = @flds ? join ('__', @flds) : '';
+
+        # Check whether sub-package is valid
+        if ($pk and not ($self->srcpkg ($pk) or $self->dummysrcpkg ($pk))) {
+          $line->error ($line->label . ': invalid sub-package in declaration.');
+          $rc = 0;
+          next;
+        }
+
+        # Setting is stored in an array reference
+        $self->setting ([$name, $pk], [])
+          if not defined $self->setting ($name, $pk);
+
+        # Add current declaration to the array if necessary
+        my $list  = $self->setting ($name, $pk);
+        my $value = $name eq 'BLD_DEP_EXCL' ? uc ($line->value) : $line->value;
+        push @$list, $value if not grep {$_ eq $value} @$list;
+
+      } else {
+        # EXE_DEP and BLOCKDATA: label field may be an executable target
+        my $target = @flds ? $flds[0] : '';
+
+        # The value contains a list of objects and/or sub-package names
+        my @deps   = split /\s+/, $line->value;
+
+        if (not @deps) {
+          if ($name eq 'BLD_BLOCKDATA') {
+            # The objects containing a BLOCKDATA program unit must be declared
+            $line->error ($line->label . ': value not set.');
+            $rc = 0;
+            next;
+
+          } else {
+            # If $value is a null string, target(s) depends on all objects
+            push @deps, '';
+          }
+        }
+
+        for my $dep (@deps) {
+          $dep =~ s/$FCM1::Config::DELIMITER_PATTERN/__/g;
+        }
+
+        $self->setting ([$name, $target], join (' ', sort @deps));
+      }
+
+      $line->parsed (1);
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_dest (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the build destination settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_dest {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc = $self->SUPER::parse_cfg_dest ($cfg_lines);
+
+  # Set up search paths
+  for my $name (@FCM1::Dest::paths) {
+    (my $label = uc ($name)) =~ s/PATH//;
+
+    $self->setting (['PATH', $label], $self->dest->$name);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_misc (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses misc build settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_misc {
+    my ($self, $cfg_lines_ref) = @_;
+    my $rc = 1;
+    my %item_of = (
+        BLD_DEP_N    => [\&_parse_cfg_misc_dep_n   , 1   ], # boolean
+        BLD_EXE_NAME => [\&_parse_cfg_misc_exe_name      ],
+        BLD_LIB      => [\&_parse_cfg_misc_dep_n         ],
+        BLD_PP       => [\&_parse_cfg_misc_dep_n   , 1   ], # boolean
+        BLD_TYPE     => [\&_parse_cfg_misc_dep_n         ],
+        INFILE_EXT   => [\&_parse_cfg_misc_file_ext, 0, 1], # uc($value)
+        OUTFILE_EXT  => [\&_parse_cfg_misc_file_ext, 1, 0], # uc($ns)
+    );
+    while (my ($key, $item) = each(%item_of)) {
+        my ($handler, @extra_arguments) = @{$item};
+        for my $line (@{$cfg_lines_ref}) {
+            if ($line->slabel_starts_with_cfg($key)) {
+                if ($handler->($self, $key, $line, @extra_arguments)) {
+                    $line->parsed(1);
+                }
+                else {
+                    $rc = 0;
+                }
+            }
+        }
+    }
+    return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# parse_cfg_misc: handler of BLD_EXE_NAME or similar.
+sub _parse_cfg_misc_exe_name {
+    my ($self, $key, $line) = @_;
+    my ($prefix, $name, @fields) = $line->slabel_fields();
+    if (!$name || @fields) {
+        $line->error(sprintf('%s: expects a single label name field.', $key));
+        return 0;
+    }
+    $self->setting([$key, $name], $line->value());
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# parse_cfg_misc: handler of BLD_DEP_N or similar.
+sub _parse_cfg_misc_dep_n {
+    my ($self, $key, $line, $value_is_boolean) = @_;
+    my ($prefix, @fields) = $line->slabel_fields();
+    my $ns = @fields ? join(q{__}, @fields) : q{};
+    if ($ns && !$self->srcpkg($ns) && !$self->dummysrcpkg($ns)) {
+        $line->error($line->label() . ': invalid sub-package in declaration.');
+        return 0;
+    }
+    my @srcpkgs
+        = $self->dummysrcpkg($ns) ? @{$self->dummysrcpkg($ns)->children()}
+        :                           $self->srcpkg($ns)
+        ;
+    my $value = $value_is_boolean ? $line->bvalue() : $line->value();
+    for my $srcpkg (@srcpkgs) {
+        $self->setting([$key, $srcpkg->pkgname()], $value);
+    }
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# parse_cfg_misc: handler of INFILE_EXT/OUTFILE_EXT or similar.
+sub _parse_cfg_misc_file_ext {
+    my ($self, $key, $line, $ns_in_uc, $value_in_uc) = @_;
+    my ($prefix, $ns) = $line->slabel_fields();
+    my $value = $value_in_uc ? uc($line->value()) : $line->value();
+    $self->setting([$key, ($ns_in_uc ? uc($ns) : $ns)], $value);
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_source (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the source package settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_source {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc  = 1;
+  my %src = ();
+
+  # Automatic source directory search?
+  # ----------------------------------------------------------------------------
+  my $search = 1;
+
+  for my $line (grep {$_->slabel_starts_with_cfg ('SEARCH_SRC')} @$cfg_lines) {
+    $search = $line->bvalue;
+    $line->parsed (1);
+  }
+
+  # Search src/ sub-directory if necessary
+  %src = %{ $self->dest->get_source_files } if $search;
+
+  # SRC declarations
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('FILE')} @$cfg_lines) {
+    # Expand ~ notation and path relative to srcdir of destination
+    my $value = $line->value;
+    $value = File::Spec->rel2abs (&expand_tilde ($value), $self->dest->srcdir);
+
+    if (! -e $value) {
+      $line->error ($value . ': source does not exist or is not readable.');
+      next;
+    }
+
+    # Package name
+    my @names = $line->slabel_fields;
+    shift @names;
+
+    # If package name not set, determine using the path if possible
+    if (not @names) {
+      my $package = $self->dest->get_pkgname_of_path ($value);
+      @names = @$package if defined $package;
+    }
+
+    if (not @names) {
+      $line->error ($self->cfglabel ('FILE') .
+                    ': package not specified/cannot be determined.');
+      next;
+    }
+
+    $src{join ('__', @names)} = $value;
+
+    $line->parsed (1);
+  }
+
+  # For directories, get non-recursive file listing, and add to %src
+  # ----------------------------------------------------------------------------
+  for my $key (keys %src) {
+    next unless -d $src{$key};
+
+    opendir DIR, $src{$key} or die $src{$key}, ': cannot read directory';
+    while (my $base = readdir 'DIR') {
+      next if $base =~ /^\./;
+
+      my $file = File::Spec->catfile ($src{$key}, $base);
+      next if ! -f $file;
+
+      my $name = join ('__', ($key, $base));
+      $src{$name} = $file unless exists $src{$name};
+    }
+    closedir DIR;
+
+    delete $src{$key};
+  }
+
+  # Set up source packages
+  # ----------------------------------------------------------------------------
+  my %pkg = ();
+  for my $name (keys %src) {
+    $pkg{$name} = FCM1::BuildSrc->new (PKGNAME => $name, SRC => $src{$name});
+  }
+
+  # INHERIT::SRC declarations
+  # ----------------------------------------------------------------------------
+  my %can_inherit = ();
+  for my $line (
+    grep {$_->slabel_starts_with_cfg(qw/INHERIT FILE/)} @{$cfg_lines}
+  ) {
+    my ($key1, $key2, @ns) = $line->slabel_fields();
+    $can_inherit{join('__', @ns)} = $line->bvalue();
+    $line->parsed(1);
+  }
+
+  # Inherit packages, if it is OK to do so
+  for my $inherited_build (reverse(@{$self->inherit()})) {
+    SRCPKG:
+    while (my ($key, $srcpkg) = each(%{$inherited_build->srcpkg()})) {
+      if (exists($pkg{$key}) || !$srcpkg->src()) {
+        next SRCPKG;
+      }
+      my $known_key = first {exists($can_inherit{$_})} @{$srcpkg->pkgnames()};
+      if (defined($known_key) && !$can_inherit{$known_key}) {
+        next SRCPKG;
+      }
+      $pkg{$key} = $srcpkg;
+    }
+  }
+
+  # Get list of intermediate "packages"
+  # ----------------------------------------------------------------------------
+  for my $name (keys %pkg) {
+    # Name of current package
+    my @names = split /__/, $name;
+
+    my $cur = $name;
+
+    while ($cur) {
+      # Name of parent package
+      pop @names;
+      my $parent = @names ? join ('__', @names) : '';
+
+      # If parent package does not exist, create it
+      $pkg{$parent} = FCM1::BuildSrc->new (PKGNAME => $parent)
+        unless exists $pkg{$parent};
+
+      # Current package is a child of the parent package
+      push @{ $pkg{$parent}->children }, $pkg{$cur}
+        unless grep {$_->pkgname eq $cur} @{ $pkg{$parent}->children };
+
+      # Go up a package
+      $cur = $parent;
+    }
+  }
+
+  $self->srcpkg (\%pkg);
+
+  # Dummy: e.g. "foo/bar/baz.egg" belongs to the "foo/bar/baz" dummy.
+  # ----------------------------------------------------------------------------
+  SRCPKG:
+  while (my ($name, $srcpkg) = each(%pkg)) {
+    if (!$srcpkg->src()) { # ensure that $srcpkg represents a source file
+      next SRCPKG;
+    }
+    my @names = split('__', $name);
+    if (@names) {
+      $names[-1] =~ s{\.\w+ \z}{}msx;
+    }
+    my $dummy_name = join('__', @names);
+    if ($dummy_name eq $name || defined($self->srcpkg($dummy_name))) {
+      next SRCPKG;
+    }
+    if (!defined($self->dummysrcpkg($dummy_name))) {
+      $self->dummysrcpkg($dummy_name, FCM1::BuildSrc->new(PKGNAME => $dummy_name));
+    }
+    push(@{$self->dummysrcpkg($dummy_name)->children()}, $srcpkg);
+  }
+
+  # Make sure a package is defined
+  # ----------------------------------------------------------------------------
+  if (not %{$self->srcpkg}) {
+    w_report 'ERROR: ', $self->cfg->actual_src, ': no source file to build.';
+    $rc = 0;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_target (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the target settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_target {
+  my ($self, $cfg_lines) = @_;
+
+  # NAME declaraions
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('NAME')} @$cfg_lines) {
+    $self->name ($line->value);
+    $line->parsed (1);
+  }
+
+  # TARGET declarations
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('TARGET')} @$cfg_lines) {
+    # Value is a space delimited list
+    push @{ $self->target }, split (/\s+/, $line->value);
+    $line->parsed (1);
+  }
+
+  # INHERIT::TARGET declarations
+  # ----------------------------------------------------------------------------
+  # By default, do not inherit target
+  my $inherit_flag = 0;
+
+  for (grep {$_->slabel_starts_with_cfg (qw/INHERIT TARGET/)} @$cfg_lines) {
+    $inherit_flag = $_->bvalue;
+    $_->parsed (1);
+  }
+
+  # Inherit targets from inherited build, if $inherit_flag is set to true
+  # ----------------------------------------------------------------------------
+  if ($inherit_flag) {
+    for my $use (reverse @{ $self->inherit }) {
+      unshift @{ $self->target }, @{ $use->target };
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_tool (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the tool settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_tool {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc = 1;
+
+  my %tools         = %{ $self->setting ('TOOL') };
+  my @package_tools = split(/$DELIMITER_LIST/, $self->setting('TOOL_PACKAGE'));
+
+  # TOOL declaration
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('TOOL')} @$cfg_lines) {
+    # Separate label into a list, delimited by double-colon, remove TOOL
+    my @flds = $line->slabel_fields;
+    shift @flds;
+
+    # Check that there is a field after TOOL
+    if (not @flds) {
+      $line->error ('TOOL: not followed by a valid label.');
+      $rc = 0;
+      next;
+    }
+
+    # The first field is the tool iteself, identified in uppercase
+    $flds[0] = uc ($flds[0]);
+
+    # Check that the tool is recognised
+    if (not exists $tools{$flds[0]}) {
+      $line->error ($flds[0] . ': not a valid TOOL.');
+      $rc = 0;
+      next;
+    }
+
+    # Check sub-package declaration
+    if (@flds > 1 and not grep {$_ eq $flds[0]} @package_tools) {
+      $line->error ($flds[0] . ': sub-package not accepted with this TOOL.');
+      $rc = 0;
+      next;
+    }
+
+    # Name of declared package
+    my $pk = join ('__', @flds[1 .. $#flds]);
+
+    # Check whether package exists
+    if (not ($self->srcpkg ($pk) or $self->dummysrcpkg ($pk))) {
+      $line->error ($line->label . ': invalid sub-package in declaration.');
+      $rc = 0;
+      next;
+    }
+
+    $self->setting (['TOOL', join ('__', @flds)], $line->value);
+    $line->parsed (1);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_write_makefile_perl5lib ();
+#
+# DESCRIPTION
+#   This method returns a makefile $string for defining $PERL5LIB.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile_perl5lib {
+  my $self = shift;
+
+  my $classpath = File::Spec->catfile (split (/::/, ref ($self))) . '.pm';
+
+  my $libdir  = dirname (dirname ($INC{$classpath}));
+  my @libpath = split (/:/, (exists $ENV{PERL5LIB} ? $ENV{PERL5LIB} : ''));
+
+  my $string = ((grep {$_ eq $libdir} @libpath)
+                ? ''
+                : 'export PERL5LIB := ' . $libdir .
+                  (exists $ENV{PERL5LIB} ? ':$(PERL5LIB)' : '') . "\n\n");
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_write_makefile_target ();
+#
+# DESCRIPTION
+#   This method returns a makefile $string for defining the default targets.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile_target {
+  my $self = shift;
+
+  # Targets of the build
+  # ----------------------------------------------------------------------------
+  my @targets = @{ $self->target };
+  if (not @targets) {
+    # Build targets not specified by user, default to building all main programs
+    my @programs = ();
+
+    # Get all main programs from all packages
+    for my $pkg (values %{ $self->srcpkg }) {
+      push @programs, $pkg->exebase if $pkg->exebase;
+    }
+
+    @programs = sort (@programs);
+
+    if (@programs) {
+      # Build main programs, if there are any
+      @targets = @programs;
+
+    } else {
+      # No main program in source tree, build the default library
+      @targets = ($self->srcpkg ('')->libbase);
+    }
+  }
+
+  my $return = 'FCM_BLD_TARGETS = ' . join (' ', @targets) . "\n\n";
+
+  # Default targets
+  $return .= '.PHONY : all' . "\n\n";
+  $return .= 'all : $(FCM_BLD_TARGETS)' . "\n\n";
+
+  # Targets for copy dummy
+  $return .= sprintf("%s:\n\ttouch \$@\n\n", $self->setting(qw/BLD_CPDUMMY/));
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_write_makefile_tool ();
+#
+# DESCRIPTION
+#   This method returns a makefile $string for defining the build tools.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile_tool {
+  my $self = shift;
+
+  # List of build tools
+  my $tool = $self->setting ('TOOL');
+
+  # List of tools local to FCM, (will not be exported)
+  my %localtool = map {($_, 1)} split ( # map into a hash table
+    /$DELIMITER_LIST/, $self->setting ('TOOL_LOCAL'),
+  );
+
+  # Export required tools
+  my $count = 0;
+  my $return = '';
+  for my $name (sort keys %$tool) {
+    # Ignore local tools
+    next if exists $localtool{(split (/__/, $name))[0]};
+
+    if ($name =~ /^\w+$/) {
+      # Tools with normal name, just export it as an environment variable
+      $return .= 'export ' . $name . ' = ' . $tool->{$name} . "\n";
+
+    } else {
+      # Tools with unusual characters, export using a label/value pair
+      $return .= 'export FCM_UNUSUAL_TOOL_LABEL' . $count . ' = ' . $name . "\n";
+      $return .= 'export FCM_UNUSUAL_TOOL_VALUE' . $count . ' = ' .
+                 $tool->{$name} . "\n";
+      $count++;
+    }
+  }
+
+  $return .= "\n";
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_write_makefile_vpath ();
+#
+# DESCRIPTION
+#   This method returns a makefile $string for defining vpath directives.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile_vpath {
+  my $self = shift();
+  my $FMT = 'vpath %%%s $(FCM_%sPATH)';
+  my %SETTING_OF = %{$self->setting('BLD_VPATH')};
+  my %EXT_OF = %{$self->setting('OUTFILE_EXT')};
+  # Note: each setting can be either an empty string or a comma-separated list
+  # of output file extension keys.
+  join(
+    "\n",
+    (
+      map
+      {
+        my $key = $_;
+        my @types = split(qr{$DELIMITER_LIST}msx, $SETTING_OF{$key});
+          @types ? (map {sprintf($FMT, $EXT_OF{$_}, $key)} sort @types)
+        :          sprintf($FMT, q{}, $key)
+        ;
+      }
+      sort keys(%SETTING_OF)
+    ),
+  ) . "\n\n";
+}
+
+# Wraps chdir. Returns the old working directory.
+sub _chdir {
+  my ($self, $path) = @_;
+  if ($self->verbose() >= 3) {
+    printf("cd %s\n", $path);
+  }
+  my $old_cwd = cwd();
+  chdir($path) || croak(sprintf("%s: cannot change directory ($!)\n", $path));
+  $old_cwd;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Build/Fortran.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Build/Fortran.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Build/Fortran.pm	(revision 5095)
@@ -0,0 +1,549 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package FCM1::Build::Fortran;
+
+use Text::Balanced qw{extract_bracketed extract_delimited};
+
+# Actions of this class
+my %ACTION_OF = (extract_interface => \&_extract_interface);
+
+# Regular expressions
+# Matches a variable attribute
+my $RE_ATTR = qr{
+    allocatable|dimension|external|intent|optional|parameter|pointer|save|target
+}imsx;
+# Matches a name
+my $RE_NAME = qr{[A-Za-z]\w*}imsx;
+# Matches a specification type
+my $RE_SPEC = qr{
+    character|complex|double\s*precision|integer|logical|real|type
+}imsx;
+# Matches the identifier of a program unit that does not have arguments
+my $RE_UNIT_BASE = qr{block\s*data|module|program}imsx;
+# Matches the identifier of a program unit that has arguments
+my $RE_UNIT_CALL = qr{function|subroutine}imsx;
+# Matches the identifier of any program unit
+my $RE_UNIT      = qr{$RE_UNIT_BASE|$RE_UNIT_CALL}msx;
+my %RE = (
+    # A comment line
+    COMMENT     => qr{\A\s*(?:!|\z)}msx,
+    # A trailing comment, capture the expression before the comment
+    COMMENT_END => qr{\A([^'"]*?)\s*!.*\z}msx,
+    # A contination marker, capture the expression before the marker
+    CONT        => qr{\A(.*)&\s*\z}msx,
+    # A contination marker at the beginning of a line, capture the marker and
+    # the expression after the marker
+    CONT_LEAD   => qr{\A(\s*&)(.*)\z}msx,
+    # Capture a variable identifier, removing any type component expression
+    NAME_COMP   => qr{\b($RE_NAME)(?:\s*\%\s*$RE_NAME)*\b}msx,
+    # Matches the first identifier in a line
+    NAME_LEAD   => qr{\A\s*$RE_NAME\s*}msx,
+    # Captures a name identifier after a comma, and the expression after
+    NAME_LIST   => qr{\A(?:.*?)\s*,\s*($RE_NAME)\b(.*)\z}msx,
+    # Captures the next quote character
+    QUOTE       => qr{\A[^'"]*(['"])}msx,
+    # Matches an attribute declaration
+    TYPE_ATTR   => qr{\A\s*($RE_ATTR)\b}msx,
+    # Matches a type declaration
+    TYPE_SPEC   => qr{\A\s*($RE_SPEC)\b}msx,
+    # Captures the expression after one or more program unit attributes
+    UNIT_ATTR   => qr{\A\s*(?:(?:elemental|recursive|pure)\s+)+(.*)\z}imsx,
+    # Captures the identifier and the symbol of a program unit with no arguments
+    UNIT_BASE   => qr{\A\s*($RE_UNIT_BASE)\s+($RE_NAME)\s*\z}imsx,
+    # Captures the identifier and the symbol of a program unit with arguments
+    UNIT_CALL   => qr{\A\s*($RE_UNIT_CALL)\s+($RE_NAME)\b}imsx,
+    # Captures the end of a program unit, its identifier and its symbol
+    UNIT_END    => qr{\A\s*(end)(?:\s+($RE_NAME)(?:\s+($RE_NAME))?)?\s*\z}imsx,
+    # Captures the expression after a program unit type specification
+    UNIT_SPEC   => qr{\A\s*$RE_SPEC\b(.*)\z}imsx,
+);
+
+# Keywords in type declaration statements
+my %TYPE_DECL_KEYWORD_SET = map { ($_, 1) } qw{
+    allocatable
+    dimension
+    in
+    inout
+    intent
+    kind
+    len
+    optional
+    out
+    parameter
+    pointer
+    save
+    target
+};
+
+# Creates and returns an instance of this class.
+sub new {
+    my ($class) = @_;
+    bless(
+        sub {
+            my $key = shift();
+            if (!exists($ACTION_OF{$key})) {
+                return;
+            }
+            $ACTION_OF{$key}->(@_);
+        },
+        $class,
+    );
+}
+
+# Methods.
+for my $key (keys(%ACTION_OF)) {
+    no strict qw{refs};
+    *{$key} = sub { my $self = shift(); $self->($key, @_) };
+}
+
+# Extracts the calling interfaces of top level subroutines and functions from
+# the $handle for reading Fortran sources.
+sub _extract_interface {
+    my ($handle) = @_;
+    map { _present_line($_) } @{_reduce_to_interface(_load($handle))};
+}
+
+# Reads $handle for the next Fortran statement, handling continuations.
+sub _load {
+    my ($handle) = @_;
+    my $ctx = {signature_token_set_of => {}, statements => []};
+    my $state = {
+        in_contains  => undef, # in a "contains" section of a program unit
+        in_interface => undef, # in an "interface" block
+        in_quote     => undef, # in a multi-line quote
+        stack        => [],    # program unit stack
+    };
+    my $NEW_STATEMENT = sub {
+        {   name        => q{}, # statement name, e.g. function, integer, ...
+            lines       => [],  # original lines in the statement
+            line_number => 0,   # line number (start) in the original source
+            symbol      => q{}, # name of a program unit (signature, end)
+            type        => q{}, # e.g. signature, use, type, attr, end
+            value       => q{}, # the actual value of the statement
+        };
+    };
+    my $statement;
+LINE:
+    while (my $line = readline($handle)) {
+        if (!defined($statement)) {
+            $statement = $NEW_STATEMENT->();
+        }
+        my $value = $line;
+        chomp($value);
+        # Pre-processor directives and continuation
+        if (!$statement->{line_number} && index($value, '#') == 0) {
+            $statement->{line_number} = $.;
+            $statement->{name}        = 'cpp';
+        }
+        if ($statement->{name} eq 'cpp') {
+            push(@{$statement->{lines}}, $line);
+            $statement->{value} .= $value;
+            if (rindex($value, '\\') != length($value) - 1) {
+                $statement = undef;
+            }
+            next LINE;
+        }
+        # Normal Fortran
+        if ($value =~ $RE{COMMENT}) {
+            next LINE;
+        }
+        if (!$statement->{line_number}) {
+            $statement->{line_number} = $.;
+        }
+        my ($cont_head, $cont_tail);
+        if ($statement->{line_number} != $.) { # is a continuation
+            ($cont_head, $cont_tail) = $value =~ $RE{CONT_LEAD};
+            if ($cont_head) {
+                $value = $cont_tail;
+            }
+        }
+        # Correctly handle ! and & in quotes
+        my ($head, $tail) = (q{}, $value);
+        if ($state->{in_quote} && index($value, $state->{in_quote}) >= 0) {
+            my $index = index($value, $state->{in_quote});
+            $head = substr($value, 0, $index + 1);
+            $tail
+                = length($value) > $index + 1
+                ? substr($value, $index + 2)
+                : q{};
+            $state->{in_quote} = undef;
+        }
+        if (!$state->{in_quote}) {
+            while ($tail) {
+                if (index($tail, q{!}) >= 0) {
+                    if (!($tail =~ s/$RE{COMMENT_END}/$1/)) {
+                        ($head, $tail, $state->{in_quote})
+                            = _load_extract_quote($head, $tail);
+                    }
+                }
+                else {
+                    while (index($tail, q{'}) > 0
+                        || index($tail, q{"}) > 0)
+                    {
+                        ($head, $tail, $state->{in_quote})
+                            = _load_extract_quote($head, $tail);
+                    }
+                    $head .= $tail;
+                    $tail = q{};
+                }
+            }
+        }
+        $cont_head ||= q{};
+        push(@{$statement->{lines}}, $cont_head . $head . $tail . "\n");
+        $statement->{value} .= $head . $tail;
+        # Process a statement only if it is marked with a continuation
+        if (!($statement->{value} =~ s/$RE{CONT}/$1/)) {
+            $statement->{value} =~ s{\s+\z}{}msx;
+            if (_process($statement, $ctx, $state)) {
+                push(@{$ctx->{statements}}, $statement);
+            }
+            $statement = undef;
+        }
+    }
+    return $ctx;
+}
+
+# Helper, removes a quoted string from $tail.
+sub _load_extract_quote {
+    my ($head, $tail) = @_;
+    my ($extracted, $remainder, $prefix)
+        = extract_delimited($tail, q{'"}, qr{[^'"]*}msx, q{});
+    if ($extracted) {
+        return ($head . $prefix . $extracted, $remainder);
+    }
+    else {
+        my ($quote) = $tail =~ $RE{QUOTE};
+        return ($head . $tail, q{}, $quote);
+    }
+}
+
+# Study statements and put attributes into array $statements
+sub _process {
+    my ($statement, $ctx, $state) = @_;
+    my $name;
+
+    # End Interface
+    if ($state->{in_interface}) {
+        if ($statement->{value} =~ qr{\A\s*end\s*interface\b}imsx) {
+            $state->{in_interface} = 0;
+        }
+        return;
+    }
+
+    # End Program Unit
+    if (@{$state->{stack}} && $statement->{value} =~ qr{\A\s*end\b}imsx) {
+        my ($end, $type, $symbol) = lc($statement->{value}) =~ $RE{UNIT_END};
+        if (!$end) {
+            return;
+        }
+        my ($top_type, $top_symbol) = @{$state->{stack}->[-1]};
+        if (!$type
+            || $top_type eq $type && (!$symbol || $top_symbol eq $symbol))
+        {
+            pop(@{$state->{stack}});
+            if ($state->{in_contains} && !@{$state->{stack}}) {
+                $state->{in_contains} = 0;
+            }
+            if (!$state->{in_contains}) {
+                $statement->{name}   = $top_type;
+                $statement->{symbol} = $top_symbol;
+                $statement->{type}   = 'end';
+                return $statement;
+            }
+        }
+        return;
+    }
+
+    # Interface/Contains
+    ($name) = $statement->{value} =~ qr{\A\s*(contains|interface)\b}imsx;
+    if ($name) {
+        $state->{'in_' . lc($name)} = 1;
+        return;
+    }
+
+    # Program Unit
+    my ($type, $symbol, @tokens) = _process_prog_unit($statement->{value});
+    if ($type) {
+        push(@{$state->{stack}}, [$type, $symbol]);
+        if ($state->{in_contains}) {
+            return;
+        }
+        $statement->{name}   = lc($type);
+        $statement->{type}   = 'signature';
+        $statement->{symbol} = lc($symbol);
+        $ctx->{signature_token_set_of}{$symbol}
+            = {map { (lc($_) => 1) } @tokens};
+        return $statement;
+    }
+    if ($state->{in_contains}) {
+        return;
+    }
+
+    # Use
+    if ($statement->{value} =~ qr{\A\s*(use)\b}imsx) {
+        $statement->{name} = 'use';
+        $statement->{type} = 'use';
+        return $statement;
+    }
+
+    # Type Declarations
+    ($name) = $statement->{value} =~ $RE{TYPE_SPEC};
+    if ($name) {
+        $name =~ s{\s}{}gmsx;
+        $statement->{name} = lc($name);
+        $statement->{type} = 'type';
+        return $statement;
+    }
+
+    # Attribute Statements
+    ($name) = $statement->{value} =~ $RE{TYPE_ATTR};
+    if ($name) {
+        $statement->{name} = $name;
+        $statement->{type} = 'attr';
+        return $statement;
+    }
+}
+
+# Parse a statement for program unit header. Returns a list containing the type,
+# the symbol and the signature tokens of the program unit.
+sub _process_prog_unit {
+    my ($string) = @_;
+    my ($type, $symbol, @args) = (q{}, q{});
+    # Is it a blockdata, module or program?
+    ($type, $symbol) = $string =~ $RE{UNIT_BASE};
+    if ($type) {
+        $type = lc($type);
+        $type =~ s{\s*}{}gmsx;
+        return ($type, $symbol);
+    }
+    # Remove the attribute and type declaration of a procedure
+    $string =~ s/$RE{UNIT_ATTR}/$1/;
+    my ($match) = $string =~ $RE{UNIT_SPEC};
+    if ($match) {
+        $string = $match;
+        extract_bracketed($string);
+    }
+    # Is it a function or subroutine?
+    ($type, $symbol) = lc($string) =~ $RE{UNIT_CALL};
+    if (!$type) {
+        return;
+    }
+    my $extracted = extract_bracketed($string, q{()}, qr{[^(]*}msx);
+
+    # Get signature tokens from SUBROUTINE/FUNCTION
+    if ($extracted) {
+        $extracted =~ s{\s}{}gmsx;
+        @args = split(q{,}, substr($extracted, 1, length($extracted) - 2));
+        if ($type eq 'function') {
+            my $result = extract_bracketed($string, q{()}, qr{[^(]*}msx);
+            if ($result) {
+                $result =~ s{\A\(\s*(.*?)\s*\)\z}{$1}msx; # remove braces
+                push(@args, $result);
+            }
+            else {
+                push(@args, $symbol);
+            }
+        }
+    }
+    return (lc($type), lc($symbol), map { lc($_) } @args);
+}
+
+# Reduces the list of statements to contain only the interface block.
+sub _reduce_to_interface {
+    my ($ctx) = @_;
+    my (%token_set, @interface_statements);
+STATEMENT:
+    for my $statement (reverse(@{$ctx->{statements}})) {
+        if ($statement->{type} eq 'end'
+            && grep { $_ eq $statement->{name} } qw{subroutine function})
+        {
+            push(@interface_statements, $statement);
+            %token_set
+                = %{$ctx->{signature_token_set_of}{$statement->{symbol}}};
+            next STATEMENT;
+        }
+        if ($statement->{type} eq 'signature'
+            && grep { $_ eq $statement->{name} } qw{subroutine function})
+        {
+            push(@interface_statements, $statement);
+            %token_set = ();
+            next STATEMENT;
+        }
+        if ($statement->{type} eq 'use') {
+            my ($head, $tail)
+                = split(qr{\s*:\s*}msx, lc($statement->{value}), 2);
+            if ($tail) {
+                my @imports = map { [split(qr{\s*=>\s*}msx, $_, 2)] }
+                    split(qr{\s*,\s*}msx, $tail);
+                my @useful_imports
+                    = grep { exists($token_set{$_->[0]}) } @imports;
+                if (!@useful_imports) {
+                    next STATEMENT;
+                }
+                if (@imports != @useful_imports) {
+                    my @token_strings
+                        = map { $_->[0] . ($_->[1] ? ' => ' . $_->[1] : q{}) }
+                        @useful_imports;
+                    my ($last, @rest) = reverse(@token_strings);
+                    my @token_lines
+                        = (reverse(map { $_ . q{,&} } @rest), $last);
+                    push(
+                        @interface_statements,
+                        {   lines => [
+                                sprintf("%s:&\n", $head),
+                                (map { sprintf(" & %s\n", $_) } @token_lines),
+                            ]
+                        },
+                    );
+                    next STATEMENT;
+                }
+            }
+            push(@interface_statements, $statement);
+            next STATEMENT;
+        }
+        if ($statement->{type} eq 'attr') {
+            my ($spec, @tokens) = ($statement->{value} =~ /$RE{NAME_COMP}/g);
+            if (grep { exists($token_set{$_}) } @tokens) {
+                for my $token (@tokens) {
+                    $token_set{$token} = 1;
+                }
+                push(@interface_statements, $statement);
+                next STATEMENT;
+            }
+        }
+        if ($statement->{type} eq 'type') {
+            my ($variable_string, $spec_string)
+                = reverse(split('::', lc($statement->{value}), 2));
+            if ($spec_string) {
+                $spec_string =~ s{$RE{NAME_LEAD}}{}msx;
+            }
+            else {
+                # The first expression in the statement is the type + attrib
+                $variable_string =~ s{$RE{NAME_LEAD}}{}msx;
+                $spec_string = extract_bracketed($variable_string, '()',
+                    qr{[\s\*]*}msx);
+            }
+            # Useful tokens are those that comes after a comma
+            my $tail = q{,} . lc($variable_string);
+            my @tokens;
+            while ($tail) {
+                if ($tail =~ qr{\A\s*['"]}msx) {
+                    extract_delimited($tail, q{'"}, qr{\A[^'"]*}msx, q{});
+                }
+                elsif ($tail =~ qr{\A\s*\(}msx) {
+                    extract_bracketed($tail, '()', qr{\A[^(]*}msx);
+                }
+                else {
+                    my $token;
+                    ($token, $tail) = $tail =~ $RE{NAME_LIST};
+                    if ($token && $token_set{$token}) {
+                        @tokens = ($variable_string =~ /$RE{NAME_COMP}/g);
+                        $tail = q{};
+                    }
+                }
+            }
+            if (@tokens && $spec_string) {
+                my @spec_tokens = (lc($spec_string) =~ /$RE{NAME_COMP}/g);
+                push(
+                    @tokens,
+                    (   grep { !exists($TYPE_DECL_KEYWORD_SET{$_}) }
+                            @spec_tokens
+                    ),
+                );
+            }
+            if (grep { exists($token_set{$_}) } @tokens) {
+                for my $token (@tokens) {
+                    $token_set{$token} = 1;
+                }
+                push(@interface_statements, $statement);
+                next STATEMENT;
+            }
+        }
+    }
+    if (!@interface_statements) {
+        return [];
+    }
+    [   {lines => ["interface\n"]},
+        reverse(@interface_statements),
+        {lines => ["end interface\n"]},
+    ];
+}
+
+# Processes and returns the line of the statement.
+sub _present_line {
+    my ($statement) = @_;
+    map {
+        s{\s+}{ }gmsx;      # collapse multiple spaces
+        s{\s+\z}{\n}msx;    # remove trailing spaces
+        $_;
+    } @{$statement->{lines}};
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+FCM1::Build::Fortran
+
+=head1 SYNOPSIS
+
+    use FCM1::Build::Fortran;
+    my $fortran_util = FCM1::Build::Fortran->new();
+    open(my($handle), '<', $path_to_a_fortran_source_file);
+    print($fortran_util->extract_interface($handle)); # prints interface
+    close($handle);
+
+=head1 DESCRIPTION
+
+A class to analyse Fortran source. Currently, it has a single method to extract
+the calling interfaces of top level subroutines and functions in a Fortran
+source.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new()
+
+Creates and returns an instance of this class.
+
+=item $instance->extract_interface($handle)
+
+Extracts the calling interfaces of top level subroutines and functions in a
+Fortran source that can be read from $handle. Returns an interface block as a
+list of lines.
+
+=back
+
+=head1 ACKNOWLEDGEMENT
+
+This module is inspired by the logic developed by the European Centre
+for Medium-Range Weather Forecasts (ECMWF).
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/BuildSrc.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/BuildSrc.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/BuildSrc.pm	(revision 5095)
@@ -0,0 +1,1509 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::BuildSrc
+#
+# DESCRIPTION
+#   This is a class to group functionalities of source in a build.
+#
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package FCM1::BuildSrc;
+use base qw{FCM1::Base};
+
+use Carp qw{croak};
+use Cwd qw{cwd};
+use FCM1::Build::Fortran;
+use FCM1::CfgFile;
+use FCM1::CfgLine;
+use FCM1::Config;
+use FCM1::Timer qw{timestamp_command};
+use FCM1::Util qw{find_file_in_path run_command};
+use File::Basename qw{basename dirname};
+use File::Spec;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+  'children',   # list of children packages
+  'is_updated', # is this source (or its associated settings) updated?
+  'mtime',      # modification time of src
+  'ppmtime',    # modification time of ppsrc
+  'ppsrc',      # full path of the pre-processed source
+  'pkgname',    # package name of the source
+  'progname',   # program unit name in the source
+  'src',        # full path of the source
+  'type',       # type of the source
+);
+
+# List of hash property methods for this class
+my @hash_properties = (
+  'dep',   # dependencies
+  'ppdep', # pre-process dependencies
+  'rules', # make rules
+);
+
+# Error message formats
+my %ERR_MESS_OF = (
+  CHDIR       => '%s: cannot change directory (%s), abort',
+  OPEN        => '%s: cannot open (%s), abort',
+  CLOSE_PIPE  => '%s: failed (%d), abort',
+);
+
+# Event message formats and levels
+my %EVENT_SETTING_OF = (
+  CHDIR            => ['%s: change directory'                   , 2],
+  F_INTERFACE_NONE => ['%s: Fortran interface generation is off', 3],
+  GET_DEPENDENCY   => ['%s: %d line(s), %d auto dependency(ies)', 3],
+);
+
+my %RE_OF = (
+  F_PREFIX => qr{
+    (?:
+      (?:ELEMENTAL|PURE(?:\s+RECURSIVE)?|RECURSIVE(?:\s+PURE)?)
+      \s+
+    )?
+  }imsx,
+  F_SPEC => qr{
+    (?:
+      (?:CHARACTER|COMPLEX|DOUBLE\s*PRECISION|INTEGER|LOGICAL|REAL|TYPE)
+      (?: \s* \( .+ \) | \s* \* \d+ \s*)??
+      \s+
+    )?
+  }imsx,
+);
+
+{
+  # Returns a singleton instance of FCM1::Build::Fortran.
+  my $FORTRAN_UTIL;
+  sub _get_fortran_util {
+    $FORTRAN_UTIL ||= FCM1::Build::Fortran->new();
+    return $FORTRAN_UTIL;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::BuildSrc->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::BuildSrc class. See
+#   above for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my ($class, %args) = @_;
+  my $self = bless(FCM1::Base->new(%args), $class);
+  for my $key (@scalar_properties, @hash_properties) {
+    $self->{$key}
+      = exists($args{uc($key)}) ? $args{uc($key)}
+      :                           undef
+      ;
+  }
+  $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+
+      if ($name eq 'ppsrc') {
+        $self->ppmtime (undef);
+
+      } elsif ($name eq 'src') {
+        $self->mtime (undef);
+      }
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'children') {
+        # Reference to an empty array
+        $self->{$name} = [];
+        
+      } elsif ($name =~ /^(?:is_cur|pkgname|ppsrc|src)$/) {
+        # Empty string
+        $self->{$name} = '';
+        
+      } elsif ($name eq 'mtime') {
+        # Modification time
+        $self->{$name} = (stat $self->src)[9] if $self->src;
+        
+      } elsif ($name eq 'ppmtime') {
+        # Modification time
+        $self->{$name} = (stat $self->ppsrc)[9] if $self->ppsrc;
+        
+      } elsif ($name eq 'type') {
+        # Attempt to get the type if src is set
+        $self->{$name} = $self->get_type if $self->src;
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @hash_properties.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (@hash_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    if (not defined $self->{$name}) {
+      if ($name eq 'rules') {
+        $self->{$name} = $self->get_rules;
+
+      } else {
+        $self->{$name} = {};
+      }
+    }
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   This method returns/sets property X, all derived from src, where X is:
+#     base  - (read-only) basename of src
+#     dir   - (read-only) dirname of src
+#     ext   - (read-only) file extension of src
+#     root  - (read-only) basename of src without the file extension
+# ------------------------------------------------------------------------------
+
+sub base {
+  return &basename ($_[0]->src);
+}
+
+# ------------------------------------------------------------------------------
+
+sub dir {
+  return &dirname ($_[0]->src);
+}
+
+# ------------------------------------------------------------------------------
+
+sub ext {
+  return substr $_[0]->base, length ($_[0]->root);
+}
+
+# ------------------------------------------------------------------------------
+
+sub root {
+  (my $root = $_[0]->base) =~ s/\.\w+$//;
+  return $root;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   This method returns/sets property X, all derived from ppsrc, where X is:
+#     ppbase  - (read-only) basename of ppsrc
+#     ppdir   - (read-only) dirname of ppsrc
+#     ppext   - (read-only) file extension of ppsrc
+#     pproot  - (read-only) basename of ppsrc without the file extension
+# ------------------------------------------------------------------------------
+
+sub ppbase {
+  return &basename ($_[0]->ppsrc);
+}
+
+# ------------------------------------------------------------------------------
+
+sub ppdir {
+  return &dirname ($_[0]->ppsrc);
+}
+
+# ------------------------------------------------------------------------------
+
+sub ppext {
+  return substr $_[0]->ppbase, length ($_[0]->pproot);
+}
+
+# ------------------------------------------------------------------------------
+
+sub pproot {
+  (my $root = $_[0]->ppbase) =~ s/\.\w+$//;
+  return $root;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#
+# DESCRIPTION
+#   This method returns/sets property X, derived from src or ppsrc, where X is:
+#     curbase  - (read-only) basename of cursrc
+#     curdir   - (read-only) dirname of cursrc
+#     curext   - (read-only) file extension of cursrc
+#     curmtime - (read-only) modification time of cursrc
+#     curroot  - (read-only) basename of cursrc without the file extension
+#     cursrc   - ppsrc or src
+# ------------------------------------------------------------------------------
+
+for my $name (qw/base dir ext mtime root src/) {
+  no strict 'refs';
+
+  my $subname = 'cur' . $name;
+
+  *$subname = sub {
+    my $self = shift;
+    my $method = $self->ppsrc ? 'pp' . $name : $name;
+    return $self->$method (@_);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $obj->X ();
+#
+# DESCRIPTION
+#   This method returns a basename X for the source, where X is:
+#     donebase      - "done" file name
+#     etcbase       - target for copying data files
+#     exebase       - executable name for source containing a main program
+#     interfacebase - Fortran interface file name
+#     libbase       - library file name
+#     objbase       - object name for source containing compilable source
+#   If the source file contains a compilable procedure, this method returns
+#   the name of the object file.
+# ------------------------------------------------------------------------------
+
+sub donebase {
+  my $self   = shift;
+
+  my $return;
+  if ($self->is_type_all ('SOURCE')) {
+    if ($self->objbase and not $self->is_type_all ('PROGRAM')) {
+      $return = ($self->progname ? $self->progname : lc ($self->curroot)) .
+                $self->setting (qw/OUTFILE_EXT DONE/);
+    }
+
+  } elsif ($self->is_type_all ('INCLUDE')) {
+    $return = $self->curbase . $self->setting (qw/OUTFILE_EXT IDONE/);
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub etcbase {
+  my $self = shift;
+
+  my $return = @{ $self->children }
+               ? $self->pkgname . $self->setting (qw/OUTFILE_EXT ETC/)
+               : undef;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub exebase {
+  my $self = shift;
+
+  my $return;
+  if ($self->objbase and $self->is_type_all ('PROGRAM')) {
+    if ($self->setting ('BLD_EXE_NAME', $self->curroot)) {
+      $return = $self->setting ('BLD_EXE_NAME', $self->curroot);
+
+    } else {
+      $return = $self->curroot . $self->setting (qw/OUTFILE_EXT EXE/);
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub interfacebase {
+  my $self = shift();
+  if (
+        defined($self->get_setting(qw/TOOL GENINTERFACE/))
+    &&  uc($self->get_setting(qw/TOOL GENINTERFACE/)) ne 'NONE'
+    &&  $self->progname()
+    &&  $self->is_type_all(qw/SOURCE/)
+    &&  $self->is_type_any(qw/FORTRAN9X FPP9X/)
+    &&  !$self->is_type_any(qw/PROGRAM MODULE BLOCKDATA/)
+  ) {
+    my $flag = lc($self->get_setting(qw/TOOL INTERFACE/));
+    my $ext  = $self->setting(qw/OUTFILE_EXT INTERFACE/);
+
+    return (($flag eq 'program' ? $self->progname() : $self->curroot()) . $ext);
+  }
+  return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub objbase {
+  my $self = shift;
+
+  my $return;
+
+  if ($self->is_type_all ('SOURCE')) {
+    my $ext = $self->setting (qw/OUTFILE_EXT OBJ/);
+
+    if ($self->is_type_any (qw/FORTRAN FPP/)) {
+      $return = lc ($self->progname) . $ext if $self->progname;
+
+    } else {
+      $return = lc ($self->curroot) . $ext;
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->flagsbase ($flag, [$index,]);
+#
+# DESCRIPTION
+#   Returns the base name of the flags file for the current package namespace
+#   for a given $flag. The returned base name should look like
+#   "LABEL___PACKAGE__NAME__SPACE.flags", where "LABEL" is normally the $flag,
+#   and "PACKAGE__NAME__SPACE" is the current package namespace without the file
+#   extension. If $flag is FLAGS or PPKEYS and $self->lang() is defined, it
+#   will attempt to determine the correct label for the language. E.g. If
+#   $self->lang() is 'C', the label will be "CFLAGS". If $index is set, returns
+#   the base name of the flags file for the $index'th element in package name
+#   space (as described in "pkgnames" method) instead of the current package
+#   name space.
+# ------------------------------------------------------------------------------
+
+sub flagsbase {
+  my ($self, $flag, $index) = @_;
+  my $name = $index ? $self->pkgnames()->[$index] : $self->pkgname();
+  my @names = split('__', $name);
+  if (@names && $self->src() && $name eq $self->pkgname()) {
+    $names[-1] =~ s{\.\w+ \z}{}msx;
+  }
+  my $label = $flag;
+  if ($self->lang() && ($flag eq 'FLAGS' || $flag eq 'PPKEYS')) {
+    if (!exists($self->setting('TOOL_SRC')->{$self->lang()}{$flag})) {
+      return;
+    }
+    $label = $self->setting('TOOL_SRC')->{$self->lang()}{$flag};
+  }
+  join('__', $label, @names) . $self->setting(qw/OUTFILE_EXT FLAGS/);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->libbase ([$prefix], [$suffix]);
+#
+# DESCRIPTION
+#   This method returns the property libbase (derived from pkgname) the base
+#   name of the library archive. $prefix and $suffix defaults to 'lib' and '.a'
+#   respectively.
+# ------------------------------------------------------------------------------
+
+sub libbase {
+  my ($self, $prefix, $suffix) = @_;
+  $prefix ||= 'lib';
+  $suffix ||= $self->setting(qw/OUTFILE_EXT LIB/);
+  if ($self->src()) { # applies to directories only
+    return;
+  }
+  my $name = $self->setting('BLD_LIB', $self->pkgname());
+  if (!defined($name)) {
+    $name = $self->pkgname();
+  }
+  $prefix . $name . $suffix;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->lang ([$setting]);
+#
+# DESCRIPTION
+#   This method returns the property lang (derived from type) the programming
+#   language name if type matches one supported in the TOOL_SRC setting. If
+#   $setting is specified, use $setting instead of TOOL_SRC.
+# ------------------------------------------------------------------------------
+
+sub lang {
+  my ($self, $setting) = @_;
+
+  my @keys = keys %{ $self->setting ($setting ? $setting : 'TOOL_SRC') };
+
+  my $return = undef;
+  for my $key (@keys) {
+    next unless $self->is_type_all ('SOURCE', $key);
+    $return = $key;
+    last;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->pkgnames;
+#
+# DESCRIPTION
+#   This method returns a list of container packages, derived from pkgname:
+# ------------------------------------------------------------------------------
+
+sub pkgnames {
+  my $self = shift;
+
+  my $return = [];
+  if ($self->pkgname) {
+    my @names = split (/__/, $self->pkgname);
+
+    for my $i (0 .. $#names) {
+      push @$return, join ('__', (@names[0 .. $i]));
+    }
+
+    unshift @$return, '';
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %dep = %{$obj->get_dep()};
+#   %dep = %{$obj->get_dep($flag)};
+#
+# DESCRIPTION
+#   This method scans the current source file for dependencies and returns the
+#   dependency hash (keys = dependencies, values = dependency types). If $flag
+#   is specified, the config setting for $flag is used to determine the types of
+#   types. Otherwise, those specified in 'BLD_TYPE_DEP' is used.
+# ------------------------------------------------------------------------------
+
+sub get_dep {
+  my ($self, $flag) = @_;
+  # Work out list of exclude for this file, using its sub-package name
+  my %EXCLUDE_SET = map {($_, 1)} @{$self->get_setting('BLD_DEP_EXCL')};
+  # Determine what dependencies are supported by this known type
+  my %DEP_TYPE_OF = %{$self->setting($flag ? $flag : 'BLD_TYPE_DEP')};
+  my %PATTERN_OF = %{$self->setting('BLD_DEP_PATTERN')};
+  my @dep_types = ();
+  if (!$self->get_setting('BLD_DEP_N')) {
+    DEP_TYPE:
+    while (my ($key, $dep_type_string) = each(%DEP_TYPE_OF)) {
+      # Check if current file is a type of file requiring dependency scan
+      if (!$self->is_type_all($key)) {
+        next DEP_TYPE;
+      }
+      # Get list of dependency type for this file
+      for my $dep_type (split(/$FCM1::Config::DELIMITER/, $dep_type_string)) {
+        if (exists($PATTERN_OF{$dep_type}) && !exists($EXCLUDE_SET{$dep_type})) {
+          push(@dep_types, $dep_type);
+        }
+      }
+    }
+  }
+
+  # Automatic dependencies
+  my %dep_of;
+  my $can_get_symbol # Also scan for program unit name in Fortran source
+      =  !$flag
+      && $self->is_type_all('SOURCE')
+      && $self->is_type_any(qw/FPP FORTRAN/)
+      ;
+  my $has_read_file;
+  if ($can_get_symbol || @dep_types) {
+    my $handle = _open($self->cursrc());
+    LINE:
+    while (my $line = readline($handle)) {
+      chomp($line);
+      if ($line =~ qr{\A \s* \z}msx) { # empty lines
+        next LINE;
+      }
+      if ($can_get_symbol) {
+        my $symbol = _get_dep_symbol($line);
+        if ($symbol) {
+          $self->progname($symbol);
+          $can_get_symbol = 0;
+          next LINE;
+        }
+      }
+      DEP_TYPE:
+      for my $dep_type (@dep_types) {
+        my ($match) = $line =~ /$PATTERN_OF{$dep_type}/i;
+        if (!$match) {
+          next DEP_TYPE;
+        }
+        # $match may contain multiple items delimited by space
+        for my $item (split(qr{\s+}msx, $match)) {
+          my $key = uc($dep_type . $FCM1::Config::DELIMITER . $item);
+          if (!exists($EXCLUDE_SET{$key})) {
+            $dep_of{$item} = $dep_type;
+          }
+        }
+        next LINE;
+      }
+    }
+    $self->_event('GET_DEPENDENCY', $self->pkgname(), $., scalar(keys(%dep_of)));
+    close($handle);
+    $has_read_file = 1;
+  }
+
+  # Manual dependencies
+  my $manual_deps_ref
+      = $self->setting('BLD_DEP' . ($flag ? '_PP' : ''), $self->pkgname());
+  if (defined($manual_deps_ref)) {
+    for (@{$manual_deps_ref}) {
+      my ($dep_type, $item) = split(/$FCM1::Config::DELIMITER/, $_, 2);
+      $dep_of{$item} = $dep_type;
+    }
+  }
+
+  return ($has_read_file, \%dep_of);
+}
+
+# Returns, if possible, the program unit declared in the $line.
+sub _get_dep_symbol {
+  my $line = shift();
+  for my $pattern (
+    qr{\A \s* $RE_OF{F_PREFIX} SUBROUTINE              \s+ ([A-Za-z]\w*)}imsx,
+    qr{\A \s* MODULE (?!\s+PROCEDURE)                  \s+ ([A-Za-z]\w*)}imsx,
+    qr{\A \s* PROGRAM                                  \s+ ([A-Za-z]\w*)}imsx,
+    qr{\A \s* $RE_OF{F_PREFIX} $RE_OF{F_SPEC} FUNCTION \s+ ([A-Za-z]\w*)}imsx,
+    qr{\A \s* BLOCK\s*DATA                             \s+ ([A-Za-z]\w*)}imsx,
+  ) {
+    my ($match) = $line =~ $pattern;
+    if ($match) {
+      return lc($match);
+    }
+  }
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @out = @{ $obj->get_fortran_interface () };
+#
+# DESCRIPTION
+#   This method invokes the Fortran interface block generator to generate
+#   an interface block for the current source file. It returns a reference to
+#   an array containing the lines of the interface block.
+# ------------------------------------------------------------------------------
+
+sub get_fortran_interface {
+  my $self = shift();
+  my %ACTION_OF = (
+    q{}    => \&_get_fortran_interface_by_internal_code,
+    f90aib => \&_get_fortran_interface_by_f90aib,
+    none   => sub {$self->_event('F_INTERFACE_NONE', $self->root()); []},
+  );
+  my $key = lc($self->get_setting(qw/TOOL GENINTERFACE/));
+  if (!$key || !exists($ACTION_OF{$key})) {
+    $key = q{};
+  }
+  $ACTION_OF{$key}->($self->cursrc());
+}
+
+# Generates Fortran interface block using "f90aib".
+sub _get_fortran_interface_by_f90aib {
+  my $path = shift();
+  my $command = sprintf(q{f90aib <'%s' 2>'%s'}, $path, File::Spec->devnull());
+  my $pipe = _open($command, '-|');
+  my @lines = readline($pipe);
+  close($pipe) || croak($ERR_MESS_OF{CLOSE_PIPE}, $command, $?);
+  \@lines;
+}
+
+# Generates Fortran interface block using internal code.
+sub _get_fortran_interface_by_internal_code {
+  my $path = shift();
+  my $handle = _open($path);
+  my @lines = _get_fortran_util()->extract_interface($handle);
+  close($handle);
+  \@lines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @out = @{ $obj->get_pre_process () };
+#
+# DESCRIPTION
+#   This method invokes the pre-processor on the source file and returns a
+#   reference to an array containing the lines of the pre-processed source on
+#   success.
+# ------------------------------------------------------------------------------
+
+sub get_pre_process {
+  my $self = shift;
+
+  # Supported source files
+  my $lang = $self->lang ('TOOL_SRC_PP');
+  return unless $lang;
+
+  # List of include directories
+  my @inc = @{ $self->setting (qw/PATH INC/) };
+
+  # Build the pre-processor command according to file type
+  my %tool        = %{ $self->setting ('TOOL') };
+  my %tool_src_pp = %{ $self->setting ('TOOL_SRC_PP', $lang) };
+
+  # The pre-processor command and its options
+  my @command = ($tool{$tool_src_pp{COMMAND}});
+  my @ppflags = split /\s+/, $self->get_setting ('TOOL', $tool_src_pp{FLAGS});
+
+  # List of defined macros, add "-D" in front of each macro
+  my @ppkeys  = split /\s+/, $self->get_setting ('TOOL', $tool_src_pp{PPKEYS});
+  @ppkeys     = map {($tool{$tool_src_pp{DEFINE}} . $_)} @ppkeys;
+
+  # Add "-I" in front of each include directories
+  @inc        = map {($tool{$tool_src_pp{INCLUDE}} . $_)} @inc;
+
+  push @command, (@ppflags, @ppkeys, @inc, $self->base);
+
+  # Change to container directory of source file
+  my $old_cwd = $self->_chdir($self->dir());
+
+  # Execute the command, getting the output lines
+  my $verbose = $self->verbose;
+  my @outlines = &run_command (
+    \@command, METHOD => 'qx', PRINT => $verbose > 1, TIME => $verbose > 2,
+  );
+
+  # Change back to original directory
+  $self->_chdir($old_cwd);
+
+  return \@outlines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rules = %{ $self->get_rules };
+#
+# DESCRIPTION
+#   This method returns a reference to a hash in the following format:
+#     $rules = {
+#       target => {ACTION => action, DEP => [dependencies], ...},
+#       ...    => {...},
+#     };
+#   where the 1st rank keys are the available targets for building this source
+#   file, the second rank keys are ACTION and DEP. The value of ACTION is the
+#   action for building the target, which can be "COMPILE", "LOAD", "TOUCH",
+#   "CP" or "AR". The value of DEP is a refernce to an array containing a list
+#   of dependencies suitable for insertion into the Makefile.
+# ------------------------------------------------------------------------------
+
+sub get_rules {
+  my $self = shift;
+
+  my $rules;
+  my %outfile_ext = %{ $self->setting ('OUTFILE_EXT') };
+
+  if ($self->is_type_all (qw/SOURCE/)) {
+    # Source file
+    # --------------------------------------------------------------------------
+    # Determine whether the language of the source file is supported
+    my %tool_src = %{ $self->setting ('TOOL_SRC') };
+
+    return () unless $self->lang;
+
+    # Compile object
+    # --------------------------------------------------------------------------
+    if ($self->objbase) {
+      # Depends on the source file
+      my @dep = ($self->rule_src);
+
+      # Depends on the compiler flags flags-file
+      my @flags;
+      push @flags, ('FLAGS' )
+        if $self->flagsbase ('FLAGS' );
+      push @flags, ('PPKEYS')
+        if $self->flagsbase ('PPKEYS') and not $self->ppsrc;
+
+      push @dep, $self->flagsbase ($_) for (@flags);
+
+      # Source file dependencies
+      for my $name (sort keys %{ $self->dep }) {
+        # A Fortran 9X module, lower case object file name
+        if ($self->dep ($name) eq 'USE') {
+          (my $root = $name) =~ s/\.\w+$//;
+          push @dep, lc ($root) . $outfile_ext{OBJ};
+
+        # An include file
+        } elsif ($self->dep ($name) =~ /^(?:INC|H|INTERFACE)$/) {
+          push @dep, $name;
+        }
+      }
+
+      $rules->{$self->objbase} = {ACTION => 'COMPILE', DEP => \@dep};
+
+      # Touch flags-files
+      # ------------------------------------------------------------------------
+      for my $flag (@flags) {
+        next unless $self->flagsbase ($flag);
+
+        $rules->{$self->flagsbase ($flag)} = {
+          ACTION => 'TOUCH',
+          DEP    => [
+            $self->flagsbase ($tool_src{$self->lang}{$flag}, -2),
+          ],
+          DEST   => '$(FCM_FLAGSDIR)',
+        };
+      }
+    }
+
+    if ($self->exebase) {
+      # Link into an executable
+      # ------------------------------------------------------------------------
+      my @dep = ();
+      push @dep, $self->objbase               if $self->objbase;
+      push @dep, $self->flagsbase ('LD'     ) if $self->flagsbase ('LD'     );
+      push @dep, $self->flagsbase ('LDFLAGS') if $self->flagsbase ('LDFLAGS');
+
+      # Depends on BLOCKDATA program units, for Fortran programs
+      my %blockdata = %{ $self->setting ('BLD_BLOCKDATA') };
+      my @blkobj    = ();
+
+      if ($self->is_type_any (qw/FPP FORTRAN/) and keys %blockdata) {
+        # List of BLOCKDATA object files
+        if (exists $blockdata{$self->exebase}) {
+          @blkobj = split /\s+/, $blockdata{$self->exebase};
+
+        } elsif (exists $blockdata{''}) {
+          @blkobj = split /\s+/, $blockdata{''};
+        }
+
+        for my $name (@blkobj) {
+          (my $root = $name) =~ s/\.\w+$//;
+          $name = $root . $outfile_ext{OBJ};
+          push @dep, $root . $outfile_ext{DONE};
+        }
+      }
+
+      # Extra executable dependencies
+      my %exe_dep = %{ $self->setting ('BLD_DEP_EXE') };
+      if (keys %exe_dep) {
+        my @exe_deps;
+        if (exists $exe_dep{$self->exebase}) {
+          @exe_deps = split /\s+/, $exe_dep{$self->exebase};
+
+        } elsif (exists $exe_dep{''}) {
+          @exe_deps = $exe_dep{''} ? split (/\s+/, $exe_dep{''}) : ('');
+        }
+
+        my $pattern = '\\' . $outfile_ext{OBJ} . '$';
+
+        for my $name (@exe_deps) {
+          if ($name =~ /$pattern/) {
+            # Extra dependency is an object
+            (my $root = $name) =~ s/\.\w+$//;
+            push @dep, $root . $outfile_ext{DONE};
+
+          } else {
+            # Extra dependency is a sub-package
+            my $var;
+            if ($self->setting ('FCM_PCK_OBJECTS', $name)) {
+              # sub-package name contains unusual characters
+              $var = $self->setting ('FCM_PCK_OBJECTS', $name);
+
+            } else {
+              # sub-package name contains normal characters
+              $var = $name ? join ('__', ('OBJECTS', $name)) : 'OBJECTS';
+            }
+
+            push @dep, '$(' . $var . ')';
+          }
+        }
+      }
+
+      # Source file dependencies
+      for my $name (sort keys %{ $self->dep }) {
+        (my $root = $name) =~ s/\.\w+$//;
+
+        # Lowercase name for object dependency
+        $root = lc ($root) unless $self->dep ($name) =~ /^(?:INC|H)$/;
+
+        # Select "done" file extension
+        if ($self->dep ($name) =~ /^(?:INC|H)$/) {
+          push @dep, $name . $outfile_ext{IDONE};
+
+        } else {
+          push @dep, $root . $outfile_ext{DONE};
+        }
+      }
+
+      $rules->{$self->exebase} = {
+        ACTION => 'LOAD', DEP => \@dep, BLOCKDATA => \@blkobj,
+      };
+
+      # Touch Linker flags-file
+      # ------------------------------------------------------------------------
+      for my $flag (qw/LD LDFLAGS/) {
+        $rules->{$self->flagsbase ($flag)} = {
+          ACTION => 'TOUCH',
+          DEP    => [$self->flagsbase ($flag, -2)],
+          DEST   => '$(FCM_FLAGSDIR)',
+        };
+      }
+
+    }
+
+    if ($self->donebase) {
+      # Touch done file
+      # ------------------------------------------------------------------------
+      my @dep = ($self->objbase);
+
+      for my $name (sort keys %{ $self->dep }) {
+        (my $root = $name) =~ s/\.\w+$//;
+
+        # Lowercase name for object dependency
+        $root = lc ($root) unless $self->dep ($name) =~ /^(?:INC|H)$/;
+
+        # Select "done" file extension
+        if ($self->dep ($name) =~ /^(?:INC|H)$/) {
+          push @dep, $name . $outfile_ext{IDONE};
+
+        } else {
+          push @dep, $root . $outfile_ext{DONE};
+        }
+      }
+
+      $rules->{$self->donebase} = {
+        ACTION => 'TOUCH', DEP => \@dep, DEST => '$(FCM_DONEDIR)',
+      };
+    }
+    
+    if ($self->interfacebase) {
+      # Interface target
+      # ------------------------------------------------------------------------
+      # Source file dependencies
+      my @dep = ();
+      for my $name (sort keys %{ $self->dep }) {
+        # Depends on Fortran 9X modules
+        push @dep, lc ($name) . $outfile_ext{OBJ}
+          if $self->dep ($name) eq 'USE';
+      }
+
+      $rules->{$self->interfacebase} = {ACTION => '', DEP => \@dep};
+    }
+
+  } elsif ($self->is_type_all ('INCLUDE')) {
+    # Copy include target
+    # --------------------------------------------------------------------------
+    my @dep = ($self->rule_src);
+
+    for my $name (sort keys %{ $self->dep }) {
+      # A Fortran 9X module, lower case object file name
+      if ($self->dep ($name) eq 'USE') {
+        (my $root = $name) =~ s/\.\w+$//;
+        push @dep, lc ($root) . $outfile_ext{OBJ};
+
+      # An include file
+      } elsif ($self->dep ($name) =~ /^(?:INC|H|INTERFACE)$/) {
+        push @dep, $name;
+      }
+    }
+
+    $rules->{$self->curbase} = {
+      ACTION => 'CP', DEP => \@dep, DEST => '$(FCM_INCDIR)',
+    };
+
+    # Touch IDONE file
+    # --------------------------------------------------------------------------
+    if ($self->donebase) {
+      my @dep = ($self->rule_src);
+
+      for my $name (sort keys %{ $self->dep }) {
+        (my $root = $name) =~ s/\.\w+$//;
+
+        # Lowercase name for object dependency
+        $root   = lc ($root) unless $self->dep ($name) =~ /^(?:INC|H)$/;
+
+        # Select "done" file extension
+        if ($self->dep ($name) =~ /^(?:INC|H)$/) {
+          push @dep, $name . $outfile_ext{IDONE};
+
+        } else {
+          push @dep, $root . $outfile_ext{DONE};
+        }
+      }
+
+      $rules->{$self->donebase} = {
+        ACTION => 'TOUCH', DEP => \@dep, DEST => '$(FCM_DONEDIR)',
+      };
+    }
+
+  } elsif ($self->is_type_any (qw/EXE SCRIPT/)) {
+    # Copy executable file
+    # --------------------------------------------------------------------------
+    my @dep = ($self->rule_src);
+
+    # Depends on dummy copy file, if file is an "always build type"
+    push @dep, $self->setting (qw/BLD_CPDUMMY/)
+      if $self->is_type_any (split (
+        /$FCM1::Config::DELIMITER_LIST/, $self->setting ('BLD_TYPE_ALWAYS_BUILD')
+      ));
+
+    # Depends on other executable files
+    for my $name (sort keys %{ $self->dep }) {
+      push @dep, $name if $self->dep ($name) eq 'EXE';
+    }
+
+    $rules->{$self->curbase} = {
+      ACTION => 'CP', DEP => \@dep, DEST => '$(FCM_BINDIR)',
+    };
+
+  } elsif (@{ $self->children }) {
+    # Targets for top level and package flags files and dummy dependencies
+    # --------------------------------------------------------------------------
+    my %tool_src   = %{ $self->setting ('TOOL_SRC') };
+    my %flags_tool = (LD => '', LDFLAGS => '');
+
+    for my $key (keys %tool_src) {
+      $flags_tool{$tool_src{$key}{FLAGS}} = $tool_src{$key}{COMMAND}
+        if exists $tool_src{$key}{FLAGS};
+
+      $flags_tool{$tool_src{$key}{PPKEYS}} = ''
+        if exists $tool_src{$key}{PPKEYS};
+    }
+
+    for my $name (sort keys %flags_tool) {
+      my @dep = $self->pkgname eq '' ? () : $self->flagsbase ($name, -2);
+      push @dep, $self->flagsbase ($flags_tool{$name})
+        if $self->pkgname eq '' and $flags_tool{$name};
+
+      $rules->{$self->flagsbase ($flags_tool{$name})} = {
+        ACTION => 'TOUCH',
+        DEST   => '$(FCM_FLAGSDIR)',
+      } if $self->pkgname eq '' and $flags_tool{$name};
+
+      $rules->{$self->flagsbase ($name)} = {
+        ACTION => 'TOUCH',
+        DEP    => \@dep,
+        DEST   => '$(FCM_FLAGSDIR)',
+      };
+    }
+
+    # Package object and library
+    # --------------------------------------------------------------------------
+    {
+      my @dep;
+      # Add objects from children
+      for my $child (sort {$a->pkgname cmp $b->pkgname} @{ $self->children }) {
+        push @dep, $child->rule_obj_var (1)
+          if $child->libbase and $child->rules ($child->libbase);
+        push @dep, $child->objbase
+          if $child->cursrc and $child->objbase and
+             not $child->is_type_any (qw/PROGRAM BLOCKDATA/);
+      }
+
+      if (@dep) {
+        $rules->{$self->libbase} = {ACTION => 'AR', DEP => \@dep};
+      }
+    }
+
+    # Package data files
+    # --------------------------------------------------------------------------
+    {
+      my @dep;
+      for my $child (@{ $self->children }) {
+        push @dep, $child->rule_src if $child->src and not $child->type;
+      }
+
+      if (@dep) {
+        push @dep, $self->setting (qw/BLD_CPDUMMY/);
+        $rules->{$self->etcbase} = {
+          ACTION => 'CP_DATA', DEP => \@dep, DEST => '$(FCM_ETCDIR)',
+        };
+      }
+    }
+  }
+
+  return $rules;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->get_setting ($setting[, @prefix]);
+#
+# DESCRIPTION
+#   This method gets the correct $setting for the current source by following
+#   its package name. If @prefix is set, get the setting with the given prefix.
+# ------------------------------------------------------------------------------
+
+sub get_setting {
+  my ($self, $setting, @prefix) = @_;
+
+  my $val;
+  for my $name (reverse @{ $self->pkgnames }) {
+    my @names = split /__/, $name;
+    $val = $self->setting ($setting, join ('__', (@prefix, @names)));
+
+    $val = $self->setting ($setting, join ('__', (@prefix, @names)))
+      if (not defined $val) and @names and $names[-1] =~ s/\.[^\.]+$//;
+    last if defined $val;
+  }
+
+  return $val;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $self->get_type();
+#
+# DESCRIPTION
+#   This method determines whether the source is a type known to the
+#   build system. If so, it returns the type flags delimited by "::".
+# ------------------------------------------------------------------------------
+
+sub get_type {
+  my $self = shift();
+  my @IGNORE_LIST
+    = split(/$FCM1::Config::DELIMITER_LIST/, $self->setting('INFILE_IGNORE'));
+  if (grep {$self->curbase() eq $_} @IGNORE_LIST) {
+    return q{};
+  }
+  # User defined
+  my $type = $self->setting('BLD_TYPE', $self->pkgname());
+  # Extension
+  if (!defined($type)) {
+    my $ext = $self->curext() ? substr($self->curext(), 1) : q{};
+    $type = $self->setting('INFILE_EXT', $ext);
+  }
+  # Pattern of name
+  if (!defined($type)) {
+    my %NAME_PATTERN_TO_TYPE_HASH = %{$self->setting('INFILE_PAT')};
+    PATTERN:
+    while (my ($pattern, $value) = each(%NAME_PATTERN_TO_TYPE_HASH)) {
+      if ($self->curbase() =~ $pattern) {
+        $type = $value;
+        last PATTERN;
+      }
+    }
+  }
+  # Pattern of #! line
+  if (!defined($type) && -s $self->cursrc() && -T _) {
+    my $handle = _open($self->cursrc());
+    my $line = readline($handle);
+    close($handle);
+    my %SHEBANG_PATTERN_TO_TYPE_HASH = %{$self->setting('INFILE_TXT')};
+    PATTERN:
+    while (my ($pattern, $value) = each(%SHEBANG_PATTERN_TO_TYPE_HASH)) {
+      if ($line =~ qr{^\#!.*$pattern}msx) {
+        $type = $value;
+        last PATTERN;
+      }
+    }
+  }
+  if (!$type) {
+    return $type;
+  }
+  # Extra type information for selected file types
+  my %EXTRA_FOR = (
+    qr{\b (?:FORTRAN|FPP) \b}msx => \&_get_type_extra_for_fortran,
+    qr{\b C \b}msx               => \&_get_type_extra_for_c,
+  );
+  EXTRA:
+  while (my ($key, $code_ref) = each(%EXTRA_FOR)) {
+    if ($type =~ $key) {
+      my $handle = _open($self->cursrc());
+      LINE:
+      while (my $line = readline($handle)) {
+        my $extra = $code_ref->($line);
+        if ($extra) {
+          $type .= $FCM1::Config::DELIMITER . $extra;
+          last LINE;
+        }
+      }
+      close($handle);
+      last EXTRA;
+    }
+  }
+  return $type;
+}
+
+sub _get_type_extra_for_fortran {
+  my ($match) = $_[0] =~ qr{\A \s* (PROGRAM|MODULE|BLOCK\s*DATA) \b}imsx;
+  if (!$match) {
+    return;
+  }
+  $match =~ s{\s}{}g;
+  uc($match)
+}
+
+sub _get_type_extra_for_c {
+  ($_[0] =~ qr{int\s+main\s*\(}msx) ? 'PROGRAM' : undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->is_in_package ($name);
+#
+# DESCRIPTION
+#   This method returns true if current package is in the package $name.
+# ------------------------------------------------------------------------------
+
+sub is_in_package {
+  my ($self, $name) = @_;
+  
+  my $return = 0;
+  for (@{ $self->pkgnames }) {
+    next unless /^$name(?:\.\w+)?$/;
+    $return = 1;
+    last;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->is_type_all ($arg, ...);
+#   $flag = $obj->is_type_any ($arg, ...);
+#
+# DESCRIPTION
+#   This method returns a flag for the following:
+#     is_type_all - does type match all of the arguments?
+#     is_type_any - does type match any of the arguments?
+# ------------------------------------------------------------------------------
+
+for my $name ('all', 'any') {
+  no strict 'refs';
+
+  my $subname = 'is_type_' . $name;
+
+  *$subname = sub {
+    my ($self, @intypes) = @_;
+
+    my $rc = 0;
+    if ($self->type) {
+      my %types = map {($_, 1)} split /$FCM1::Config::DELIMITER/, $self->type;
+
+      for my $intype (@intypes) {
+        $rc = exists $types{$intype};
+        last if ($name eq 'all' and not $rc) or ($name eq 'any' and $rc);
+      }
+    }
+
+    return $rc;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->rule_obj_var ([$read]);
+#
+# DESCRIPTION
+#   This method returns a string containing the make rule object variable for
+#   the current package. If $read is set, return $($string)
+# ------------------------------------------------------------------------------
+
+sub rule_obj_var {
+  my ($self, $read) = @_;
+
+  my $return;
+  if ($self->setting ('FCM_PCK_OBJECTS', $self->pkgname)) {
+    # Package name registered in unusual list
+    $return = $self->setting ('FCM_PCK_OBJECTS', $self->pkgname);
+
+  } else {
+    # Package name not registered in unusual list
+    $return = $self->pkgname
+              ? join ('__', ('OBJECTS', $self->pkgname)) : 'OBJECTS';
+  }
+
+  $return = $read ? '$(' . $return . ')' : $return;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->rule_src ();
+#
+# DESCRIPTION
+#   This method returns a string containing the location of the source file
+#   relative to the build root. This string will be suitable for use in a
+#   "Make" rule file for FCM.
+# ------------------------------------------------------------------------------
+
+sub rule_src {
+  my $self = shift;
+
+  my $return = $self->cursrc;
+  LABEL: for my $name (qw/SRC PPSRC/) {
+    for my $i (0 .. @{ $self->setting ('PATH', $name) } - 1) {
+      my $dir = $self->setting ('PATH', $name)->[$i];
+      next unless index ($self->cursrc, $dir) == 0;
+
+      $return = File::Spec->catfile (
+        '$(FCM_' . $name . 'DIR' . ($i ? $i : '') . ')',
+        File::Spec->abs2rel ($self->cursrc, $dir),
+      );
+      last LABEL;
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->write_lib_dep_excl ();
+#
+# DESCRIPTION
+#   This method writes a set of exclude dependency configurations for the
+#   library of this package.
+# ------------------------------------------------------------------------------
+
+sub write_lib_dep_excl {
+  my $self = shift();
+  if (!find_file_in_path($self->libbase(), $self->setting(qw/PATH LIB/))) {
+    return 0;
+  }
+
+  my $ETC_DIR = $self->setting(qw/PATH ETC/)->[0];
+  my $CFG_EXT = $self->setting(qw/OUTFILE_EXT CFG/);
+  my $LABEL_OF_EXCL_DEP = $self->cfglabel('BLD_DEP_EXCL');
+  my @SETTINGS = (
+       #dependency   #source file type list       #dependency name function
+       ['H'        , [qw{INCLUDE CPP          }], sub {$_[0]->base()}         ],
+       ['INTERFACE', [qw{INCLUDE INTERFACE    }], sub {$_[0]->base()}         ],
+       ['INC'      , [qw{INCLUDE              }], sub {$_[0]->base()}         ],
+       ['USE'      , [qw{SOURCE FORTRAN MODULE}], sub {$_[0]->root()}         ],
+       ['INTERFACE', [qw{SOURCE FORTRAN       }], sub {$_[0]->interfacebase()}],
+       ['OBJ'      , [qw{SOURCE               }], sub {$_[0]->root()}         ],
+  );
+
+  my $cfg = FCM1::CfgFile->new();
+  my @stack = ($self);
+  NODE:
+  while (my $node = pop(@stack)) {
+    # Is a directory
+    if (@{$node->children()}) {
+      push(@stack, reverse(@{$node->children()}));
+      next NODE;
+    }
+    # Is a typed file
+    if (
+          $node->cursrc()
+      &&  $node->type()
+      &&  !$node->is_type_any(qw{PROGRAM BLOCKDATA})
+    ) {
+      for (@SETTINGS) {
+        my ($key, $type_list_ref, $name_func_ref) = @{$_};
+        my $name = $name_func_ref->($node);
+        if ($name && $node->is_type_all(@{$type_list_ref})) {
+          push(
+            @{$cfg->lines()},
+            FCM1::CfgLine->new(
+              label => $LABEL_OF_EXCL_DEP,
+              value => $key . $FCM1::Config::DELIMITER . $name,
+            ),
+          );
+          next NODE;
+        }
+      }
+    }
+  }
+
+  # Write to configuration file
+  $cfg->print_cfg(
+    File::Spec->catfile($ETC_DIR, $self->libbase('lib', $CFG_EXT)),
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->write_rules ();
+#
+# DESCRIPTION
+#   This method returns a string containing the "Make" rules for building the
+#   source file.
+# ------------------------------------------------------------------------------
+
+sub write_rules {
+  my $self  = shift;
+  my $mk    = '';
+
+  for my $target (sort keys %{ $self->rules }) {
+    my $rule = $self->rules ($target);
+    next unless defined ($rule->{ACTION});
+
+    if ($rule->{ACTION} eq 'AR') {
+      my $var = $self->rule_obj_var;
+      $mk .= ($var eq 'OBJECTS' ? 'export ' : '') . $var . ' =';
+      $mk .= ' ' . join (' ', @{ $rule->{DEP} });
+      $mk .= "\n\n";
+    }
+
+    $mk .= $target . ':';
+    
+    if ($rule->{ACTION} eq 'AR') {
+      $mk .= ' ' . $self->rule_obj_var (1);
+
+    } else {
+      for my $dep (@{ $rule->{DEP} }) {
+        $mk .= ' ' . $dep;
+      }
+    }
+
+    $mk .= "\n";
+
+    if (exists $rule->{ACTION}) {
+      if ($rule->{ACTION} eq 'AR') {
+        $mk .= "\t" . 'fcm_internal archive $@ $^' . "\n";
+
+      } elsif ($rule->{ACTION} eq 'CP') {
+        $mk .= "\t" . 'cp $< ' . $rule->{DEST} . "\n";
+        $mk .= "\t" . 'chmod u+w ' .
+               File::Spec->catfile ($rule->{DEST}, '$@') . "\n";
+
+      } elsif ($rule->{ACTION} eq 'CP_DATA') {
+        $mk .= "\t" . 'cp $^ ' . $rule->{DEST} . "\n";
+        $mk .= "\t" . 'touch ' .
+               File::Spec->catfile ($rule->{DEST}, '$@') . "\n";
+
+      } elsif ($rule->{ACTION} eq 'COMPILE') {
+        if ($self->lang) {
+          $mk .= "\t" . 'fcm_internal compile:' . substr ($self->lang, 0, 1) .
+                 ' ' . $self->pkgnames->[-2] . ' $< $@';
+          $mk .= ' 1' if ($self->flagsbase ('PPKEYS') and not $self->ppsrc);
+          $mk .= "\n";
+        }
+
+      } elsif ($rule->{ACTION} eq 'LOAD') {
+        if ($self->lang) {
+          $mk .= "\t" . 'fcm_internal load:' . substr ($self->lang, 0, 1) .
+                 ' ' . $self->pkgnames->[-2] . ' $< $@';
+          $mk .= ' ' . join (' ', @{ $rule->{BLOCKDATA} })
+            if @{ $rule->{BLOCKDATA} };
+          $mk .= "\n";
+        }
+
+      } elsif ($rule->{ACTION} eq 'TOUCH') {
+        $mk .= "\t" . 'touch ' .
+               File::Spec->catfile ($rule->{DEST}, '$@') . "\n";
+      }
+    }
+
+    $mk .= "\n";
+  }
+
+  return $mk;
+}
+
+# Wraps "chdir". Returns old directory.
+sub _chdir {
+  my ($self, $dir) = @_;
+  my $old_cwd = cwd();
+  $self->_event('CHDIR', $dir);
+  chdir($dir) || croak(sprintf($ERR_MESS_OF{CHDIR}, $dir));
+  $old_cwd;
+}
+
+# Wraps an event.
+sub _event {
+  my ($self, $key, @args) = @_;
+  my ($format, $level) = @{$EVENT_SETTING_OF{$key}};
+  $level ||= 1;
+  if ($self->verbose() >= $level) {
+    printf($format . ".\n", @args);
+  }
+}
+
+# Wraps "open".
+sub _open {
+  my ($path, $mode) = @_;
+  $mode ||= '<';
+  open(my $handle, $mode, $path) || croak(sprintf($ERR_MESS_OF{OPEN}, $path, $!));
+  $handle;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/BuildTask.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/BuildTask.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/BuildTask.pm	(revision 5095)
@@ -0,0 +1,353 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::BuildTask
+#
+# DESCRIPTION
+#   This class hosts information of a build task in the FCM build system.
+#
+# ------------------------------------------------------------------------------
+
+package FCM1::BuildTask;
+@ISA = qw(FCM1::Base);
+
+# Standard pragma
+use strict;
+use warnings;
+
+# Standard modules
+use Carp;
+use File::Compare;
+use File::Copy;
+use File::Basename;
+use File::Path;
+use File::Spec::Functions;
+
+# FCM component modules
+use FCM1::Base;
+use FCM1::Timer;
+use FCM1::Util;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'actiontype',  # type of action
+  'dependency',  # list of dependencies for this target
+  'srcfile',     # reference to input FCM1::BuildSrc instance
+  'output',      # output file
+  'outputmtime', # output file modification time
+  'target',      # target name for this task
+  'targetpath',  # search path for the target
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::BuildTask->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::BuildTask class. See
+#   above for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = FCM1::Base->new (%args);
+
+  bless $self, $class;
+
+  for my $name (@scalar_properties) {
+    $self->{$name} = exists $args{uc ($name)} ? $args{uc ($name)} : undef;
+  }
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+
+      if ($name eq 'output') {
+        $self->{outputmtime} = $_[0] ? (stat $_[0]) [9] : undef;
+      }
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'dependency' or $name eq 'targetpath') {
+        # Reference to an array
+        $self->{$name} = [];
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->action (TASKLIST => \%tasklist);
+#
+# DESCRIPTION
+#   This method performs the task action and sets the output accordingly. The
+#   argument TASKLIST must be a reference to a hash containing the other tasks
+#   of the build, which this task may depend on. The keys of the hash must the
+#   name of the target names of the tasks, and the values of the hash must be
+#   the references to the corresponding FCM1::BuildTask instances. The method
+#   returns true if the task has been performed to create a new version of the
+#   target.
+# ------------------------------------------------------------------------------
+
+sub action {
+  my $self     = shift;
+  my %args     = @_;
+  my $tasklist = exists $args{TASKLIST} ? $args{TASKLIST} : {};
+
+  return unless $self->actiontype;
+
+  my $uptodate     = 1;
+  my $dep_uptodate = 1;
+
+  # Check if dependencies are up to date
+  # ----------------------------------------------------------------------------
+  for my $depend (@{ $self->dependency }) {
+    if (exists $tasklist->{$depend}) {
+      if (not $tasklist->{$depend}->output) {
+        # Dependency task output is not set, performs its task action
+        if ($tasklist->{$depend}->action (TASKLIST => $tasklist)) {
+          $uptodate     = 0;
+          $dep_uptodate = 0;
+        }
+      }
+
+    } elsif ($self->verbose > 1) {
+      w_report 'Warning: Task for "', $depend,
+               '" does not exist, may be required by ', $self->target;
+    }
+  }
+
+  # Check if the target exists in the search path
+  # ----------------------------------------------------------------------------
+  if (@{ $self->targetpath }) {
+    my $output = find_file_in_path ($self->target, $self->targetpath);
+    $self->output ($output) if $output;
+  }
+
+  # Target is out of date if it does not exist
+  if ($uptodate) {
+    $uptodate = 0 if not $self->output;
+  }
+
+  # Check if current target is older than its dependencies
+  # ----------------------------------------------------------------------------
+  if ($uptodate) {
+    for my $depend (@{ $self->dependency }) {
+      next unless exists $tasklist->{$depend};
+
+      if ($tasklist->{$depend}->outputmtime > $self->outputmtime) {
+        $uptodate     = 0;
+        $dep_uptodate = 0;
+      }
+    }
+
+    if ($uptodate and ref $self->srcfile) {
+      $uptodate = 0 if $self->srcfile->mtime > $self->outputmtime;
+    }
+  }
+
+  if ($uptodate) {
+    # Current target and its dependencies are up to date
+    # --------------------------------------------------------------------------
+    if ($self->actiontype eq 'PP') {
+      # "done" file up to date, set name of pre-processed source file
+      # ------------------------------------------------------------------------
+      my $base     = $self->srcfile->root . lc ($self->srcfile->ext);
+      my @pknames  = split '__', (@{ $self->srcfile->pkgnames })[-2];
+      my @path     = map {
+        catfile ($_, @pknames);
+      } @{ $self->setting (qw/PATH PPSRC/) };
+      my $oldfile = find_file_in_path ($base, \@path);
+      $self->srcfile->ppsrc ($oldfile);
+    }
+
+  } else {
+    # Perform action is not up to date
+    # --------------------------------------------------------------------------
+    # (For GENINTERFACE and PP, perform action if "done" file not up to date)
+    my $new_output = @{ $self->targetpath }
+                     ? catfile ($self->targetpath->[0], $self->target)
+                     : $self->target;
+
+    # Create destination container directory if necessary
+    my $destdir = dirname $new_output;
+
+    if (not -d $destdir) {
+      print 'Make directory: ', $destdir, "\n" if $self->verbose > 2;
+      mkpath $destdir;
+    }
+
+    # List of actions
+    if ($self->actiontype eq 'UPDATE') {
+      # Action is UPDATE: Update file
+      # ------------------------------------------------------------------------
+      print 'Update: ', $new_output, "\n" if $self->verbose > 2;
+      touch_file $new_output
+        or croak 'Unable to update "', $new_output, '", abort';
+      $self->output ($new_output);
+
+    } elsif ($self->actiontype eq 'COPY') {
+      # Action is COPY: copy file to destination if necessary
+      # ------------------------------------------------------------------------
+      my $copy_required = ($dep_uptodate and $self->output and -f $self->output)
+                          ? compare ($self->output, $self->srcfile->src)
+                          : 1;
+
+      if ($copy_required) {
+        # Set up copy command
+        my $srcfile = $self->srcfile->src;
+        my $destfile = catfile ($destdir, basename($srcfile));
+        print 'Copy: ', $srcfile, "\n", '  to: ', $destfile, "\n"
+          if $self->verbose > 2;
+        &copy ($srcfile, $destfile)
+          or die $srcfile, ': copy to ', $destfile, ' failed (', $!, '), abort';
+        chmod (((stat ($srcfile))[2] & 07777), $destfile);
+
+        $self->output ($new_output);
+
+      } else {
+        $uptodate = 1;
+      }
+
+    } elsif ($self->actiontype eq 'PP' or $self->actiontype eq 'GENINTERFACE') {
+      # Action is PP or GENINTERFACE: process file
+      # ------------------------------------------------------------------------
+      my ($newlines, $base, @path);
+
+      if ($self->actiontype eq 'PP') {
+        # Invoke the pre-processor on the source file
+        # ----------------------------------------------------------------------
+        # Get lines in the pre-processed source
+        $newlines = $self->srcfile->get_pre_process;
+        $base     = $self->srcfile->root . lc ($self->srcfile->ext);
+
+        # Get search path for the existing pre-processed file
+        my @pknames  = split '__', (@{ $self->srcfile->pkgnames })[-2];
+        @path        = map {
+          catfile ($_, @pknames);
+        } @{ $self->setting (qw/PATH PPSRC/) };
+
+      } else { # if ($self->actiontype eq 'GENINTERFACE')
+        # Invoke the interface generator
+        # ----------------------------------------------------------------------
+        # Get new interface lines
+        $newlines = $self->srcfile->get_fortran_interface;
+
+        # Get search path for the existing interface file
+        $base     = $self->srcfile->interfacebase;
+        @path     = @{ $self->setting (qw/PATH INC/) },
+      }
+
+
+      # If pre-processed or interface file exists,
+      # compare its content with new lines to see if it has been updated
+      my $update_required = 1;
+      my $oldfile = find_file_in_path ($base, \@path);
+
+      if ($oldfile and -f $oldfile) {
+        # Read old file
+        open FILE, '<', $oldfile;
+        my @oldlines = readline 'FILE';
+        close FILE;
+
+        # Compare old contents and new contents
+        if (@oldlines eq @$newlines) {
+          $update_required = grep {
+            $oldlines[$_] ne $newlines->[$_];
+          } (0 .. $#oldlines);
+        }
+      }
+
+      if ($update_required) {
+        # Update the pre-processed source or interface file
+        # ----------------------------------------------------------------------
+        # Determine container directory of the  pre-processed or interface file
+        my $newfile = @path ? catfile ($path[0], $base) : $base;
+
+        # Create the container directory if necessary
+        if (not -d $path[0]) {
+          print 'Make directory: ', $path[0], "\n"
+            if $self->verbose > 1;
+          mkpath $path[0];
+        }
+
+        # Update the pre-processor or interface file
+        open FILE, '>', $newfile
+          or croak 'Cannot write to "', $newfile, '" (', $!, '), abort';
+        print FILE @$newlines;
+        close FILE
+          or croak 'Cannot write to "', $newfile, '" (', $!, '), abort';
+        print 'Generated: ', $newfile, "\n" if $self->verbose > 1;
+
+        # Set the name of the pre-processed file
+        $self->srcfile->ppsrc ($newfile) if $self->actiontype eq 'PP';
+
+      } else {
+        # Content in pre-processed source or interface file is up to date
+        # ----------------------------------------------------------------------
+        $uptodate = 1;
+
+        # Set the name of the pre-processed file
+        $self->srcfile->ppsrc ($oldfile) if $self->actiontype eq 'PP';
+      }
+
+      # Update the "done" file
+      print 'Update: ', $new_output, "\n" if $self->verbose > 2;
+      touch_file $new_output
+        or croak 'Unable to update "', $new_output, '", abort';
+      $self->output ($new_output);
+
+    } else {
+      carp 'Action type "', $self->actiontype, "' not supported";
+    }
+  }
+
+  return not $uptodate;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/CfgFile.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/CfgFile.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/CfgFile.pm	(revision 5095)
@@ -0,0 +1,599 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::CfgFile
+#
+# DESCRIPTION
+#   This class is used for reading and writing FCM config files. A FCM config
+#   file is a line-based text file that provides information on how to perform
+#   a particular task using the FCM system.
+#
+# ------------------------------------------------------------------------------
+
+package FCM1::CfgFile;
+@ISA = qw(FCM1::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Basename;
+use File::Path;
+use File::Spec;
+
+# FCM component modules
+use FCM1::Base;
+use FCM1::CfgLine;
+use FCM1::Config;
+use FCM1::Keyword;
+use FCM1::Util;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'actual_src', # actual source of configuration file
+  'lines',      # list of lines, FCM1::CfgLine objects
+  'pegrev',     # peg revision of configuration file
+  'src',        # source of configuration file
+  'type',       # type of configuration file
+  'version',    # version of configuration file
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::CfgFile->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::CfgFile class. See above
+#   for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = FCM1::Base->new (%args);
+
+  bless $self, $class;
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+  }
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    if (not defined $self->{$name}) {
+      if ($name eq 'lines') {
+        $self->{$name} = [];
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mtime = $obj->mtime ();
+#
+# DESCRIPTION
+#   This method returns the modified time of the configuration file source.
+# ------------------------------------------------------------------------------
+
+sub mtime {
+  my $self  = shift;
+  my $mtime = undef;
+
+  if (-f $self->src) {
+    $mtime = (stat $self->src)[9];
+  }
+
+  return $mtime;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $read = $obj->read_cfg($is_for_inheritance);
+#
+# DESCRIPTION
+#   This method reads the current configuration file. It returns the number of
+#   lines read from the config file, or "undef" if it fails. The result is
+#   placed in the LINES array of the current instance, and can be accessed via
+#   the "lines" method.
+# ------------------------------------------------------------------------------
+
+sub read_cfg {
+  my ($self, $is_for_inheritance) = @_;
+
+  my @lines = $self->_get_cfg_lines($is_for_inheritance);
+
+  # List of CFG types that need INC declarations expansion
+  my %exp_inc    = ();
+  for (split (/$FCM1::Config::DELIMITER_LIST/, $self->setting ('CFG_EXP_INC'))) {
+    $exp_inc{uc ($_)} = 1;
+  }
+
+  # List of CFG labels that are reserved keywords
+  my %cfg_keywords = ();
+  for (split (/$FCM1::Config::DELIMITER_LIST/, $self->setting ('CFG_KEYWORD'))) {
+    $cfg_keywords{$self->cfglabel ($_)} = 1;
+  }
+
+  # Loop each line, to separate lines into label : value pairs
+  my $cont = undef;
+  my $here = undef;
+  for my $line_num (1 .. @lines) {
+    my $line = $lines[$line_num - 1];
+    chomp $line;
+
+    my $label   = '';
+    my $value   = '';
+    my $comment = '';
+
+    # If this line is a continuation, set $start to point to the line that
+    # starts this continuation. Otherwise, set $start to undef
+    my $start = defined ($cont) ? $self->lines->[$cont] : undef;
+    my $warning = undef;
+
+    if ($line =~ /^(\s*#.*)$/) { # comment line
+      $comment = $1;
+
+    } elsif ($line =~ /\S/) {    # non-blank line
+      if (defined $cont) {
+        # Previous line has a continuation mark
+        $value = $line;
+
+        # Separate value and comment
+        if ($value =~ s/((?:\s+|^)#\s+.*)$//) {
+          $comment = $1;
+        }
+
+        # Remove leading spaces
+        $value =~ s/^\s*\\?//;
+
+        # Expand environment variables
+        my $warn;
+        ($value, $warn) = $self->_expand_variable ($value, 1) if $value;
+        $warning .= ($warning ? ', ' : '') . $warn if $warn;
+
+        # Expand internal variables
+        ($value, $warn) = $self->_expand_variable ($value, 0) if $value;
+        $warning .= ($warning ? ', ' : '') . $warn if $warn;
+
+        # Get "line" that begins the current continuation
+        my $v = $start->value . $value;
+        $v =~ s/\\$//;
+        $start->value ($v);
+
+      } else {
+        # Previous line does not have a continuation mark
+        if ($line =~ /^\s*(\S+)(?:\s+(.*))?$/) {
+          # Check line contains a valid label:value pair
+          $label = $1;
+          $value = defined ($2) ? $2 : '';
+
+          # Separate value and comment
+          if ($value =~ s/((?:\s+|^)#\s+.*)$//) {
+            $comment = $1;
+          }
+
+          # Remove trailing spaces
+          $value =~ s/\s+$//;
+
+          # Value begins with $HERE?
+          $here  = ($value =~ /\$\{?HERE\}?(?:[^A-Z_]|$)/);
+
+          # Expand environment variables
+          my $warn;
+          ($value, $warn) = $self->_expand_variable ($value, 1) if $value;
+          $warning .= ($warning ? ', ' : '') . $warn if $warn;
+
+          # Expand internal variables
+          ($value, $warn) = $self->_expand_variable ($value, 0) if $value;
+          $warning .= ($warning ? ', ' : '') . $warn if $warn;
+        }
+      }
+
+      # Determine whether current line ends with a continuation mark
+      if ($value =~ s/\\$//) {
+        $cont = scalar (@{ $self->lines }) unless defined $cont;
+
+      } else {
+        $cont = undef;
+      }
+    }
+
+    if (    defined($self->type())
+        &&  exists($exp_inc{uc($self->type())})
+        &&  uc($start ? $start->label() : $label) eq $self->cfglabel('INC')
+        &&  !defined($cont)
+    ) {
+      # Current configuration file requires expansion of INC declarations
+      # The start/current line is an INC declaration
+      # The current line is not a continuation or is the end of the continuation
+
+      # Get lines from an "include" configuration file
+      my $src = ($start ? $start->value : $value);
+      $src   .= '@' . $self->pegrev if $here and $self->pegrev;
+
+      if ($src) {
+        # Invoke a new instance to read the source
+        my $cfg = FCM1::CfgFile->new (
+          SRC => expand_tilde ($src), TYPE => $self->type,
+        );
+
+        $cfg->read_cfg;
+
+        # Add lines to the lines array in the current configuration file
+        $comment = 'INC ' . $src . ' ';
+        push @{$self->lines}, FCM1::CfgLine->new (
+          comment => $comment . '# Start',
+          number  => ($start ? $start->number : $line_num),
+          src     => $self->actual_src,
+          warning => $warning,
+        );
+        push @{ $self->lines }, @{ $cfg->lines };
+        push @{$self->lines}, FCM1::CfgLine->new (
+          comment => $comment . '# End',
+          src     => $self->actual_src,
+        );
+
+      } else {
+        push @{$self->lines}, FCM1::CfgLine->new (
+          number  => $line_num,
+          src     => $self->actual_src,
+          warning => 'empty INC declaration.'
+        );
+      }
+
+    } else {
+      # Push label:value pair into lines array
+      push @{$self->lines}, FCM1::CfgLine->new (
+        label   => $label,
+        value   => ($label ? $value : ''),
+        comment => $comment,
+        number  => $line_num,
+        src     => $self->actual_src,
+        warning => $warning,
+      );
+    }
+
+    next if defined $cont; # current line not a continuation
+
+    my $slabel = ($start ? $start->label : $label);
+    my $svalue = ($start ? $start->value : $value);
+    next unless $slabel;
+
+    # Check config file type and version
+    if (index (uc ($slabel), $self->cfglabel ('CFGFILE')) == 0) {
+      my @words = split /$FCM1::Config::DELIMITER_PATTERN/, $slabel;
+      shift @words;
+
+      my $name = @words ? lc ($words[0]) : 'type';
+
+      if ($self->can ($name)) {
+        $self->$name ($svalue);
+      }
+    }
+
+    # Set internal variable
+    $slabel =~ s/^\%//; # Remove leading "%" from label
+
+    $self->config->variable ($slabel, $svalue)
+      unless exists $cfg_keywords{$slabel};
+  }
+
+  # Report and reset warnings
+  # ----------------------------------------------------------------------------
+  for my $line (@{ $self->lines }) {
+    w_report $line->format_warning if $line->warning;
+    $line->warning (undef);
+  }
+
+  return @{ $self->lines };
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->print_cfg ($file, [$force]);
+#
+# DESCRIPTION
+#   This method prints the content of current configuration file. If no
+#   argument is specified, it prints output to the standard output. If $file is
+#   specified, and is a writable file name, the output is sent to the file.  If
+#   the file already exists, its content is compared to the current output.
+#   Nothing will be written if the content is unchanged unless $force is
+#   specified. Otherwise, for typed configuration files, the existing file is
+#   renamed using a prefix that contains its last modified time. The method
+#   returns 1 if there is no error.
+# ------------------------------------------------------------------------------
+
+sub print_cfg {
+  my ($self, $file, $force) = @_;
+
+  # Count maximum number of characters in the labels, (for pretty printing)
+  my $max_label_len = 0;
+  for my $line (@{ $self->lines }) {
+    next unless $line->label;
+    my $label_len  = length $line->label;
+    $max_label_len = $label_len if $label_len > $max_label_len;
+  }
+
+  # Output string
+  my $out = '';
+
+  # Append each line of the config file to the output string
+  for my $line (@{ $self->lines }) {
+    $out .= $line->print_line ($max_label_len - length ($line->label) + 1);
+    $out .= "\n";
+  }
+
+  if ($out) {
+    my $out_handle = select();
+
+    # Open file if necessary
+    if ($file) {
+      # Make sure the host directory exists and is writable
+      my $dirname = dirname $file;
+      if (not -d $dirname) {
+        print 'Make directory: ', $dirname, "\n" if $self->verbose;
+        mkpath $dirname;
+      }
+      croak $dirname, ': cannot write to config file directory, abort'
+        unless -d $dirname;
+
+      if (-f $file and not $force) {
+        # Read old config file to see if content has changed
+        open(my $handle, '<', $file) || croak("$file: $!\n");
+        my $in_lines = '';
+        while (my $line = readline($handle)) {
+          $in_lines .= $line;
+        }
+        close($handle);
+
+        # Return if content is up-to-date
+        if ($in_lines eq $out) {
+          print 'No change in ', lc ($self->type), ' cfg: ', $file, "\n"
+            if $self->verbose > 1 and $self->type;
+          return 1;
+        }
+
+        # If config file already exists, make sure it is writable
+        if ($self->type) {
+          # Existing config file writable, rename it using its time stamp
+          my $mtime = (stat $file)[9];
+          my ($sec, $min, $hour, $mday, $mon, $year) = (gmtime $mtime)[0 .. 5];
+          my $timestamp = sprintf '%4d%2.2d%2.2d_%2.2d%2.2d%2.2d_',
+                          $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
+          my $oldfile   = File::Spec->catfile (
+            $dirname, $timestamp . basename ($file)
+          );
+          rename $file, $oldfile;
+          print 'Rename existing ', lc ($self->type), ' cfg: ',
+                $oldfile, "\n" if $self->verbose > 1;
+        }
+      }
+
+      # Open file and select file handle
+      open(my $handle, '>', $file) || croak("$file: $!\n");
+      $out_handle = $handle;
+    }
+
+    # Print output
+    print($out_handle $out);
+
+    # Close file if necessary
+    if ($file) {
+      close($out_handle) || croak("$file: $!\n");
+
+      if ($self->type and $self->verbose > 1) {
+        print 'Generated ', lc ($self->type), ' cfg: ', $file, "\n";
+
+      } elsif ($self->verbose > 2) {
+        print 'Generated cfg: ', $file, "\n";
+      }
+    }
+
+  } else {
+    # Warn if nothing to print
+    my $warning = 'Empty configuration';
+    $warning   .= ' - nothing written to file: ' . $file if $file;
+    carp $warning if $self->type;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @lines = $self->_get_cfg_lines($is_for_inheritance);
+#
+# DESCRIPTION
+#   This internal method opens the configuration file and returns its contents
+#   as an array of lines. If the $self->src() is given as a URI, the method
+#   tries to read it with "svn cat". Otherwise, the method tries to read
+#   $self->src() with open() and readline(). If $self->type() is not a known
+#   type, $self->src() can only be a regular file and $is_for_inheritance is
+#   ignored.  Otherwise, $self->src() can be a regular file or a directory and
+#   $is_for_inheritance is used to determine the behaviour for searching the
+#   directory for a configuration file. If $is_for_inheritance is set, the
+#   config file may be located at "$src/cfg/$type.cfg". If $is_for_inheritance
+#   is not set, the config file may be located at "$src/$type.cfg" or
+#   "$src/cfg/$type.cfg".
+# ------------------------------------------------------------------------------
+
+sub _get_cfg_lines {
+  my ($self, $is_for_inheritance) = @_;
+  my $DIAG = sub {};
+  my @paths_refs = ([]);
+  if ($self->type() && exists($self->setting('CFG_NAME')->{uc($self->type())})) {
+    my $base = $self->setting('CFG_NAME')->{uc($self->type())};
+    if (!$is_for_inheritance) {
+      push(@paths_refs, [$base]);
+    }
+    push(@paths_refs, [$self->setting(qw/DIR CFG/), $base]);
+    if ($self->verbose()) {
+      $DIAG = sub {printf("Config file (%s): %s\n", $self->type(), @_)};
+    }
+  }
+  if ($self->src() =~ qr{\A([A-Za-z][\w\+-\.]*):}xms) {
+    # $self->src() is a URI, try "svn cat"
+    my $src = FCM1::Util::tidy_url(FCM1::Keyword::expand($self->src()));
+    my ($uri, $rev) = $src =~ qr{\A(.+?)(?:\@([^\@]+))?\z}msx;
+    $rev ||= 'HEAD';
+    for my $paths_ref (@paths_refs) {
+      my $path = join('/', $uri, @{$paths_ref}) . '@' . $rev;
+      local($@);
+      my @lines = eval {
+        run_command([qw/svn cat/, $path], METHOD => 'qx', DEVNULL => 1);
+      };
+      if (!$@) {
+        $self->pegrev($rev);
+        $self->actual_src($path);
+        $DIAG->($path);
+        return @lines;
+      }
+    }
+  }
+  else {
+    # $self->src() is not a URI, assume that it resides in the file system
+    for my $paths_ref (@paths_refs) {
+      my $path = File::Spec->catfile($self->src(), @{$paths_ref});
+      if (-e $path && !-d $path) { # "-f $path" returns false for "/dev/null"
+        open(my $handle, '<', $path)
+          || croak("$path: cannot open config file, abort: $!");
+        my @lines = readline($handle);
+        close($handle);
+        $self->actual_src($path);
+        $DIAG->($path);
+        return @lines;
+      }
+    }
+  }
+  croak(sprintf("%s: cannot locate config file, abort", $self->src()));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_expand_variable ($string, $env[, \%recursive_set]);
+#
+# DESCRIPTION
+#   This internal method expands variables in $string. If $env is true, it
+#   expands environment variables. Otherwise, it expands local variables. If
+#   %recursive_set is specified, it indicates that this method is being called
+#   recursively. In which case, it must not attempt to expand a variable that
+#   exists in the keys of %recursive_set.
+# ------------------------------------------------------------------------------
+
+sub _expand_variable {
+  my ($self, $string, $env, $recursive_set_ref) = @_;
+
+  # Pattern for environment/local variable
+  my @patterns = $env
+    ? (qr#\$([A-Z][A-Z0-9_]+)#, qr#\$\{([A-Z][A-Z0-9_]+)\}#)
+    : (qr#%(\w+(?:::[\w\.-]+)*)#, qr#%\{(\w+(?:(?:::|/)[\w\.-]+)*)\}#);
+
+  my $ret = '';
+  my $warning = undef;
+  while ($string) {
+    # Find the first match in $string
+    my ($prematch, $match, $postmatch, $var_label);
+    for my $pattern (@patterns) {
+      next unless $string =~ /$pattern/;
+      if ((not defined $prematch) or length ($`) < length ($prematch)) {
+        $prematch = $`;
+        $match = $&;
+        $var_label = $1;
+        $postmatch = $';
+      }
+    }
+
+    if ($match) {
+      $ret .= $prematch;
+      $string = $postmatch;
+
+      # Get variable value from environment or local configuration
+      my $variable = $env
+                     ? (exists $ENV{$var_label} ? $ENV{$var_label} : undef)
+                     : $self->config->variable ($var_label);
+
+      if ($env and $var_label eq 'HERE' and not defined $variable) {
+        $variable = dirname ($self->actual_src);
+        $variable = File::Spec->rel2abs ($variable) if not &is_url ($variable);
+      }
+
+      # Substitute match with value of variable
+      if (defined $variable) {
+        my %set = (($recursive_set_ref ? %{$recursive_set_ref} : ()));
+        if (exists($set{$var_label})) {
+          $warning .= ', ' if $warning;
+          $warning .= $match . ': cyclic dependency, variable not expanded';
+          $ret .= $variable;
+
+        } else {
+          my ($r, $w)
+            = $self->_expand_variable($variable, $env, {%set, $var_label => 1});
+          $ret .= $r;
+          if ($w) {
+            $warning .= ', ' if $warning;
+            $warning .= $w;
+          }
+        }
+
+      } else {
+        $warning .= ', ' if $warning;
+        $warning .= $match . ': variable not expanded';
+        $ret .= $match;
+      }
+
+    } else {
+      $ret .= $string;
+      $string = "";
+    }
+  }
+
+  return ($ret, $warning);
+}
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/CfgLine.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/CfgLine.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/CfgLine.pm	(revision 5095)
@@ -0,0 +1,346 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::CfgLine
+#
+# DESCRIPTION
+#   This class is used for grouping the settings in each line of a FCM
+#   configuration file.
+#
+# ------------------------------------------------------------------------------
+
+package FCM1::CfgLine;
+@ISA = qw(FCM1::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use File::Basename;
+
+# In-house modules
+use FCM1::Base;
+use FCM1::Config;
+use FCM1::Util;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'bvalue',  # line value, in boolean
+  'comment', # (in)line comment
+  'error',   # error message for incorrect usage while parsing the line
+  'label',   # line label
+  'line',    # content of the line
+  'number',  # line number in source file
+  'parsed',  # has this line been parsed (by the extract/build system)?
+  'prefix',  # optional prefix for line label
+  'slabel',  # label without the optional prefix
+  'src',     # name of source file
+  'value',   # line value
+  'warning', # warning message for deprecated usage
+);
+
+# Useful variables
+our $COMMENT_RULER = '-' x 78;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = FCM1::CfgLine->comment_block (@comment);
+#
+# DESCRIPTION
+#   This method returns a list of FCM1::CfgLine objects representing a comment
+#   block with the comment string @comment.
+# ------------------------------------------------------------------------------
+
+sub comment_block {
+  my @return = (
+    FCM1::CfgLine->new (comment => $COMMENT_RULER),
+    (map {FCM1::CfgLine->new (comment => $_)} @_),
+    FCM1::CfgLine->new (comment => $COMMENT_RULER),
+    FCM1::CfgLine->new (),
+  );
+
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::CfgLine->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::CfgLine class. See above
+#   for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = FCM1::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+    $self->{$_} = $args{$_} if exists $args{$_};
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    if (@_) {
+      $self->{$name} = $_[0];
+
+      if ($name eq 'line' or $name eq 'label') {
+        $self->{slabel} = undef;
+
+      } elsif ($name eq 'line' or $name eq 'value') {
+        $self->{bvalue} = undef;
+      }
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name =~ /^(?:comment|error|label|line|prefix|src|value)$/) {
+        # Blank
+        $self->{$name} = '';
+
+      } elsif ($name eq 'slabel') {
+        if ($self->prefix and $self->label_starts_with ($self->prefix)) {
+          $self->{$name} = $self->label_from_field (1);
+
+        } else {
+          $self->{$name} = $self->label;
+        }
+
+      } elsif ($name eq 'bvalue') {
+        if (defined ($self->value)) {
+          $self->{$name} = ($self->value =~ /^(\s*|false|no|off|0*)$/i)
+                           ? 0 : $self->value;
+        }
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @fields = $obj->label_fields ();
+#   @fields = $obj->slabel_fields ();
+#
+# DESCRIPTION
+#   These method returns a list of fields in the (s)label.
+# ------------------------------------------------------------------------------
+
+for my $name (qw/label slabel/) {
+  no strict 'refs';
+
+  my $sub_name = $name . '_fields';
+  *$sub_name = sub  {
+    return (split (/$FCM1::Config::DELIMITER_PATTERN/, $_[0]->$name));
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->label_from_field ($index);
+#   $string = $obj->slabel_from_field ($index);
+#
+# DESCRIPTION
+#   These method returns the (s)label from field $index onwards.
+# ------------------------------------------------------------------------------
+
+for my $name (qw/label slabel/) {
+  no strict 'refs';
+
+  my $sub_name = $name . '_from_field';
+  *$sub_name = sub  {
+    my ($self, $index) = @_;
+    my $method = $name . '_fields';
+    my @fields = $self->$method;
+    return join ($FCM1::Config::DELIMITER, @fields[$index .. $#fields]);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->label_starts_with (@fields);
+#   $flag = $obj->slabel_starts_with (@fields);
+#
+# DESCRIPTION
+#   These method returns a true if (s)label starts with the labels in @fields
+#   (ignore case).
+# ------------------------------------------------------------------------------
+
+for my $name (qw/label slabel/) {
+  no strict 'refs';
+
+  my $sub_name = $name . '_starts_with';
+  *$sub_name = sub  {
+    my ($self, @fields) = @_;
+    my $return = 1;
+
+    my $method = $name . '_fields';
+    my @all_fields = $self->$method;
+
+    for my $i (0 .. $#fields) {
+      next if $all_fields[$i] && lc($fields[$i]) eq lc($all_fields[$i]);
+      $return = 0;
+      last;
+    }
+
+    return $return;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->label_starts_with_cfg (@fields);
+#   $flag = $obj->slabel_starts_with_cfg (@fields);
+#
+# DESCRIPTION
+#   These method returns a true if (s)label starts with the configuration file
+#   labels in @fields (ignore case).
+# ------------------------------------------------------------------------------
+
+for my $name (qw/label slabel/) {
+  no strict 'refs';
+
+  my $sub_name = $name . '_starts_with_cfg';
+  *$sub_name = sub  {
+    my ($self, @fields) = @_;
+
+    for my $field (@fields) {
+      $field = $self->cfglabel ($field);
+    }
+
+    my $method = $name . '_starts_with';
+    return $self->$method (@fields);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mesg = $obj->format_error ();
+#
+# DESCRIPTION
+#   This method returns a string containing a formatted error message for
+#   anything reported to the current line.
+# ------------------------------------------------------------------------------
+
+sub format_error {
+  my ($self) = @_;
+  my $mesg = '';
+
+  $mesg .= $self->format_warning;
+
+  if ($self->error or not $self->parsed) {
+    $mesg = 'ERROR: ' . $self->src . ': LINE ' . $self->number . ':' . "\n";
+    if ($self->error) {
+      $mesg .= '       ' . $self->error;
+
+    } else {
+      $mesg .= '       ' . $self->label . ': label not recognised.';
+    }
+  }
+
+  return $mesg;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mesg = $obj->format_warning ();
+#
+# DESCRIPTION
+#   This method returns a string containing a formatted warning message for
+#   any warning reported to the current line.
+# ------------------------------------------------------------------------------
+
+sub format_warning {
+  my ($self) = @_;
+  my $mesg = '';
+
+  if ($self->warning) {
+    $mesg = 'WARNING: ' . $self->src . ': LINE ' . $self->number . ':' . "\n";
+    $mesg .= '         ' . $self->warning;
+  }
+
+  return $mesg;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $line = $obj->print_line ([$space]);
+#
+# DESCRIPTION
+#   This method returns a configuration line using $self->label, $self->value
+#   and $self->comment. The value in $self->line is re-set. If $space is set
+#   and is a positive integer, it sets the spacing between the label and the
+#   value in the line. The default is 1.
+# ------------------------------------------------------------------------------
+
+sub print_line {
+  my ($self, $space) = @_;
+
+  # Set space between label and value, default to 1 character
+  $space = 1 unless $space and $space =~ /^[1-9]\d*$/;
+
+  my $line = '';
+
+  # Add label and value, if label is set
+  if ($self->label) {
+    $line .= $self->label . ' ' x $space;
+    $line .= $self->value if defined $self->value;
+  }
+
+  # Add comment if necessary
+  my $comment = $self->comment;
+  $comment =~ s/^\s*//;
+
+  if ($comment) {
+    $comment = '# ' . $comment if $comment !~ /^#/;
+    $line .= ' ' if $line;
+    $line .= $comment;
+  }
+
+  return $self->line ($line);
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Cm.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Cm.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Cm.pm	(revision 5095)
@@ -0,0 +1,2272 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::Cm
+#
+# DESCRIPTION
+#   This module contains the FCM code management functionalities and wrappers
+#   to Subversion commands.
+#
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package FCM1::Cm;
+use base qw{Exporter};
+
+our @EXPORT_OK = qw(cm_check_missing cm_check_unknown cm_switch cm_update);
+
+use Cwd qw{cwd};
+use FCM::System::Exception;
+use FCM1::Config;
+use FCM1::CmBranch;
+use FCM1::CmUrl;
+use FCM1::Keyword;
+use FCM1::Util      qw{
+    get_url_of_wc
+    get_url_peg_of_wc
+    is_url
+    is_wc
+    tidy_url
+};
+use File::Basename qw{basename dirname};
+use File::Path qw{mkpath rmtree};
+use File::Spec;
+use Text::ParseWords qw{shellwords};
+
+# ------------------------------------------------------------------------------
+
+# CLI message handler
+our $CLI_MESSAGE = \&_cli_message;
+
+# List of CLI messages
+our %CLI_MESSAGE_FOR = (
+    q{}           => "%s",
+    BRANCH_LIST   => "%s at %s: %d branch(es) found for %s.\n",
+    CHDIR_WCT     => "%s: working directory changed to top of working copy.\n",
+    CF            => "Conflicts in: %s\n",
+    MERGE_ACTUAL  => "-" x 74 . "actual\n%s" . "-" x 74 . "actual\n",
+    MERGE_COMPARE => "Merge: %s\n c.f.: %s\n",
+    MERGE_OK      => "Merge succeeded.\n",
+    MERGE_DRYRUN  => "-" x 73 . "dry-run\n%s" . "-" x 73 . "dry-run\n",
+    MERGE_REVS    => "Eligible merge(s) from %s: %s\n",
+    OUT_DIR       => "Output directory: %s\n",
+    PATCH_DONE    => "%s: patch generated.\n",
+    PATCH_REV     => "Patch created for changeset %s\n",
+    SEPARATOR     => q{-} x 80 . "\n",
+    STATUS        => "%s: status of %s:\n%s\n",
+);
+
+# CLI abort and error messages
+our %CLI_MESSAGE_FOR_ABORT = (
+    FAIL => "%s: command failed.\n",
+    NULL => "%s: command will result in no change.\n",
+    USER => "%s: abort by user.\n",
+);
+
+# CLI abort and error messages
+our %CLI_MESSAGE_FOR_ERROR = (
+    CHDIR               => "%s: cannot change to directory.\n",
+    CLI                 => "%s",
+    CLI_HELP            => "Type 'fcm help %s' for usage.\n",
+    CLI_MERGE_ARG1      => "Arg 1 must be the source in auto/custom mode.\n",
+    CLI_MERGE_ARG2      => "Arg 2 must be the source in custom mode"
+                           . " if --revision not set.\n",
+    CLI_OPT_ARG         => "--%s: invalid argument [%s].\n",
+    CLI_OPT_WITH_OPT    => "--%s: must be specified with --%s.\n",
+    CLI_USAGE           => "incorrect value for the %s argument",
+    DIFF_PROJECTS       => "%s (target) and %s (source) are not related.\n",
+    INVALID_BRANCH      => "%s: not a valid URL of a standard FCM branch.\n",
+    INVALID_PROJECT     => "%s: not a valid URL of a standard FCM project.\n",
+    INVALID_TARGET      => "%s: not a valid working copy or URL.\n",
+    INVALID_URL         => "%s: not a valid URL.\n",
+    INVALID_WC          => "%s: not a valid working copy.\n",
+    MERGE_REV_INVALID   => "%s: not a revision in the available merge list.\n",
+    MERGE_SELF          => "%s: cannot be merged to its own working copy: %s.\n",
+    MERGE_UNRELATED     => "%s: target and %s: source not directly related.\n",
+    MERGE_UNSAFE        => "%s: source contains changes outside the target"
+                           . " sub-directory. Please merge with a full tree.\n",
+    MKPATH              => "%s: cannot create directory.\n",
+    NOT_EXIST           => "%s: does not exist.\n",
+    PARENT_NOT_EXIST    => "%s: parent %s no longer exists.\n",
+    RMTREE              => "%s: cannot remove.\n",
+    ST_CI_MESG_FILE     => "Attempt to add commit message file:\n%s",
+    ST_CONFLICT         => "File(s) in conflicts:\n%s",
+    ST_MISSING          => "File(s) missing:\n%s",
+    ST_OOD              => "File(s) out of date:\n%s",
+    SWITCH_UNSAFE       => "%s: merge template exists."
+                           . " Please remove before retrying.\n",
+    WC_INVALID_BRANCH   => "%s: not a working copy of a standard FCM branch.\n",
+    WC_URL_NOT_EXIST    => "%s: working copy URL does not exists at HEAD.\n",
+);
+
+# List of CLI prompt messages
+our %CLI_MESSAGE_FOR_PROMPT = (
+    CF_OVERWRITE      => qq{%s: existing changes will be overwritten.\n}
+                         . qq{ Do you wish to continue?},
+    CI                => qq{Would you like to commit this change?},
+    CI_BRANCH_SHARED  => qq{\n}
+                         . qq{*** WARNING: YOU ARE COMMITTING TO A %s BRANCH.\n}
+                         . qq{*** Please ensure that you have the}
+                         . qq{ owner's permission.\n\n}
+                         . qq{Would you like to commit this change?},
+    CI_BRANCH_USER    => qq{\n}
+                         . qq{*** WARNING: YOU ARE COMMITTING TO A BRANCH}
+                         . qq{ NOT OWNED BY YOU.\n}
+                         . qq{*** Please ensure that you have the}
+                         . qq{ owner's permission.\n\n}
+                         . qq{Would you like to commit this change?},
+    CI_TRUNK          => qq{\n}
+                         . qq{*** WARNING: YOU ARE COMMITTING TO THE TRUNK.\n}
+                         . qq{*** Please ensure that your change conforms to}
+                         . qq{ your project's working practices.\n\n}
+                         . qq{Would you like to commit this change?},
+    CONTINUE          => qq{%s: continue?},
+    MERGE             => qq{Would you like to go ahead with the merge?},
+    MERGE_REV         => qq{Enter a revision},
+    MKPATCH_OVERWRITE => qq{%s: output location exists. OK to overwrite?},
+    RUN_SVN_COMMAND   => qq{Would you like to run "svn %s"?},
+);
+
+# List of CLI warning messages
+our %CLI_MESSAGE_FOR_WARNING = (
+    BRANCH_SUBDIR   => "%s: is a sub-directory of a branch in a FCM project.\n",
+    CF_BINARY       => "%s: ignoring binary file, please resolve manually.\n",
+    INVALID_BRANCH  => $CLI_MESSAGE_FOR_ERROR{INVALID_BRANCH},
+    ST_IN_TRAC_DIFF => "%s: local changes cannot be displayed in Trac.\n"
+);
+
+# CLI prompt handler and title prefix
+our $CLI_PROMPT = \&_cli_prompt;
+our $CLI_PROMPT_PREFIX = q{fcm };
+
+# Event handlers
+our %CLI_HANDLER_OF = (
+    'WC_STATUS'      => \&_cli_handler_of_wc_status,
+    'WC_STATUS_PATH' => \&_cli_handler_of_wc_status_path,
+);
+
+# Common patterns
+our %PATTERN_OF = (
+    # A CLI option
+    CLI_OPT => qr{
+        \A            (?# beginning)
+        (--\w[\w-]*=) (?# capture 1, a long option label)
+        (.*)          (?# capture 2, the value of the option)
+        \z            (?# end)
+    }xms,
+    # A CLI revision option
+    CLI_OPT_REV => qr{
+        \A                      (?# beginning)
+        (--revision(?:=|\z)|-r) (?# capture 1, --revision, --revision= or -r)
+        (.*)                    (?# capture 2, trailing value)
+        \z                      (?# end)
+    }xms,
+    # A CLI revision option range
+    CLI_OPT_REV_RANGE => qr{
+        \A                  (?# beginning)
+        (                   (?# capture 1, begin)
+            (?:\{[^\}]+\}+) (?# a date in curly braces)
+            |               (?# or)
+            [^:]+           (?# anything but a colon)
+        )                   (?# capture 1, end)
+        (?::(.*))?          (?# colon, and capture 2 til the end)
+        \z                  (?# end)
+    }xms,
+    # A FCM branch path look-alike, should be configurable in the future
+    FCM_BRANCH_PATH => qr{
+        \A                            (?# beginning)
+        /*                            (?# some slashes)
+        (?:                           (?# group 1, begin)
+            (?:trunk/*(?:@\d+)?\z)    (?# trunk at a revision)
+            |                         (?# or)
+            (?:trunk|branches|tags)/+ (?# trunk, branch or tags)
+        )                             (?# group 1, end)
+    }xms,
+    # Last line of output from "svn status -u"
+    ST_AGAINST_REV => qr{
+        \A                           (?# beginning)
+        Status\sagainst\srevision:.* (?# output of svn status -u)
+        \z                           (?# end)
+    }xms,
+    # Extract path from "svn status"
+    ST_PATH => qr{
+        \A   (?# beginning)
+        .{6} (?# 6 columns)
+        \s+  (?# spaces)
+        (.+) (?# capture 1, target path)
+        \z   (?# end)
+    }xms,
+    # A legitimate "svn" revision
+    SVN_REV => qr{
+        \A                                      (?# beginning)
+        (?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\}) (?# digit, reserved words, date)
+        \z                                      (?# end)
+    }ixms,
+);
+
+# Status matchers
+our %ST_MATCHER_FOR = (
+    CONFLICT => sub {substr($_[0], 0, 1) eq 'C' || substr($_[0], 6, 1) eq 'C'},
+    MISSING  => sub {substr($_[0], 0, 1) eq '!'},
+    MODIFIED => sub {substr($_[0], 0, 7) =~ qr{\S}xms},
+    OOD      => sub {substr($_[0], 8, 1) eq '*'},
+    UNKNOWN  => sub {substr($_[0], 0, 1) eq '?'},
+);
+
+# Set the FCM::Util object by FCM::System::CM.
+our $UTIL;
+sub set_util {
+    $UTIL = shift();
+}
+
+# Set the commit message utility provided by FCM::System::CM.
+our $COMMIT_MESSAGE_UTIL;
+sub set_commit_message_util {
+    $COMMIT_MESSAGE_UTIL = shift();
+    FCM1::CmBranch::set_commit_message_util($COMMIT_MESSAGE_UTIL);
+}
+
+# Set the SVN utility provided by FCM::System::CM.
+our $SVN;
+sub set_svn_util {
+    $SVN = shift();
+    FCM1::CmUrl::set_svn_util($SVN);
+    FCM1::CmBranch::set_svn_util($SVN);
+}
+
+# Returns the branch URL as an instance of FCM1::CmUrl.
+sub _branch_url {
+    my $arg = shift();
+    my $url
+        = $arg && is_url($arg) ? FCM1::CmUrl->new(URL => $arg)
+        : $arg && is_wc($arg)  ? FCM1::CmUrl->new(URL => get_url_of_wc($arg))
+        : !$arg && is_wc()     ? FCM1::CmUrl->new(URL => get_url_of_wc())
+        :                        undef
+        ;
+    if (!$url) {
+        return _cm_err(FCM1::Cm::Exception->INVALID_TARGET, $arg ? $arg : q{.});
+    }
+    $url;
+}
+
+# Branch delete.
+sub cm_branch_delete {
+    my ($option_ref, $arg) = @_;
+    my $branch = cm_branch_info($option_ref, $arg);
+    $branch->del(
+        PASSWORD            => $option_ref->{password},
+        NON_INTERACTIVE     => $option_ref->{'non-interactive'},
+        SVN_NON_INTERACTIVE => $option_ref->{'svn-non-interactive'},
+    );
+    if (!$arg && $option_ref->{'switch'}) {
+        cm_switch($option_ref, $branch->layout()->get_config()->{'dir-trunk'});
+    }
+}
+
+# Branch diff.
+sub cm_branch_diff {
+    my ($option_ref, $target) = @_;
+    local(%ENV) = %ENV;
+    $ENV{FCM_GRAPHIC_DIFF} ||= $UTIL->external_cfg_get('graphic-diff');
+    my @diff_cmd
+        = $option_ref->{graphical}  ? (qw{
+            --config-option config:working-copy:exclusive-locking-clients=
+            --diff-cmd fcm_graphic_diff
+        })
+        : $option_ref->{'diff-cmd'} ? ('--diff-cmd', $option_ref->{'diff-cmd'})
+        :                             ()
+        ;
+    if ($option_ref->{extensions}) {
+        push(@diff_cmd, '--extensions', shellwords($option_ref->{extensions}));
+    }
+
+    # Target can be a URL/path, default to $PWD.
+    $target ||= q{.};
+    my $target_is_path = !is_url($target);
+
+    # Get repository and branch information
+    my $url = bless(_branch_url($target), 'FCM1::CmBranch');
+
+    # Check that URL is a standard FCM branch
+    if (!$url->is_branch()) {
+        return _cm_err(FCM1::Cm::Exception->INVALID_BRANCH, $url->url_peg());
+    }
+
+    # Save and remove sub-directory part of the URL
+    my $subdir = $url->subdir();
+    $url->url_peg($url->branch_url_peg());
+
+    # Check that $url exists
+    if (!$url->url_exists()) {
+        return _cm_err(FCM1::Cm::Exception->INVALID_URL, $url->url_peg());
+    }
+
+    # Compare current branch with its parent
+    my $parent = FCM1::CmBranch->new(URL => $url->parent()->url());
+    if ($url->pegrev()) {
+      $parent->url_peg($parent->url() . '@' . $url->pegrev());
+    }
+
+    if (!$parent->url_exists()) {
+        return _cm_err(
+            FCM1::Cm::Exception->PARENT_NOT_EXIST, $url->url_peg(), $parent->url(),
+        );
+    }
+
+    my $base = $parent->base_of_merge_from($url);
+
+    # Ensure the correct diff (syntax) is displayed
+    # Reinstate the sub-tree part into the URL
+    if ($subdir) {
+      $url->url_peg($url->branch_url() . '/' . $subdir . '@' . $url->pegrev());
+      $base->url_peg($base->branch_url() . '/' . $subdir . '@' . $base->pegrev());
+    }
+
+    if ($option_ref->{trac} || $option_ref->{wiki}) {
+        if ($target_is_path && _svn_status_get([$target])) {
+            $CLI_MESSAGE->('ST_IN_TRAC_DIFF', $target);
+        }
+
+        # Trac wiki syntax
+        my $wiki_syntax = 'diff:' . $base->path_peg() . '//' . $url->path_peg();
+
+        if ($option_ref->{wiki}) {
+            $CLI_MESSAGE->(q{}, "$wiki_syntax\n");
+        }
+        else { # if $option_ref->{trac}
+            my $browser = $UTIL->external_cfg_get('browser');
+            my $trac_url = FCM1::Keyword::get_browser_url($url->project_url());
+            # FIXME: assuming that the browser URL uses the InterTrac syntax
+            $trac_url =~ s{/intertrac/.*$}{/search?q=$wiki_syntax}xms;
+            my %value_of = %{$UTIL->shell_simple([$browser, $trac_url])};
+            if ($value_of{rc}) {
+                return FCM::System::Exception->throw(
+                    FCM::System::Exception->SHELL,
+                    {command_list => [$browser, $trac_url], %value_of},
+                    $value_of{e},
+                );
+            }
+        }
+    }
+    else {
+        $SVN->call(
+            'diff', @diff_cmd,
+            ($option_ref->{summarize} ? ('--summarize') : ()),
+		    ($option_ref->{xml} ? ('--xml') : ()),
+            '--old', $base->url_peg(),
+            '--new', ($target_is_path ? $target : $url->url_peg()),
+        );
+    }
+}
+
+# Branch info.
+sub cm_branch_info {
+    my ($option_ref, $arg) = @_;
+    my $url = _branch_url($arg);
+    FCM1::Config->instance()->verbose($option_ref->{verbose} ? 1 : 0);
+    my $branch = FCM1::CmBranch->new(URL => $url->url_peg());
+    if (!$branch->branch()) {
+        return _cm_err(FCM1::Cm::Exception->INVALID_BRANCH, $branch->url_peg());
+    }
+    if (!$branch->url_exists()) {
+        return _cm_err(FCM1::Cm::Exception->NOT_EXIST, $branch->url_peg());
+    }
+    $branch->url_peg($branch->branch_url_peg());
+    $option_ref->{'show-children'} ||= $option_ref->{'show-all'};
+    $option_ref->{'show-other'   } ||= $option_ref->{'show-all'};
+    $option_ref->{'show-siblings'} ||= $option_ref->{'show-all'};
+    $branch->display_info(
+        SHOW_CHILDREN => $option_ref->{'show-children'},
+        SHOW_OTHER    => $option_ref->{'show-other'   },
+        SHOW_SIBLINGS => $option_ref->{'show-siblings'},
+    );
+    $branch;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &FCM1::Cm::cm_commit ();
+#
+# DESCRIPTION
+#   This is a FCM wrapper to the "svn commit" command.
+# ------------------------------------------------------------------------------
+
+sub cm_commit {
+  my ($option_ref, $path) = @_;
+  $path ||= cwd();
+  if (!-e $path) {
+    return _cm_err(FCM1::Cm::Exception->NOT_EXIST, $path);
+  }
+
+  # Make sure we are in a working copy
+  if (!is_wc($path)) {
+    return _cm_err(FCM1::Cm::Exception->INVALID_WC, $path);
+  }
+
+  # Make sure we are at the top level of the working copy
+  # (otherwise we might miss any template commit message)
+  my $dir = $SVN->get_wc_root($path);
+
+  if ($dir ne cwd ()) {
+    chdir($dir) || return _cm_err(FCM1::Cm::Exception->CHDIR, $dir);
+    $CLI_MESSAGE->('CHDIR_WCT', $dir);
+  }
+
+  # Get update status of working copy
+  # Check working copy files are not in conflict, missing, or out of date
+  my @status = _svn_status_get([], 1);
+  if (!defined($option_ref->{'dry-run'})) {
+    my %st_lines_of = (CONFLICT => [], MISSING => [], OOD => []);
+
+    LINE:
+    for my $line (@status) {
+      for my $key (keys(%st_lines_of)) {
+        if ($line && $ST_MATCHER_FOR{$key}->($line)) {
+          push(@{$st_lines_of{$key}}, $line);
+          next LINE;
+        }
+      }
+      # Check that all files which have been added have the svn:executable
+      # property set correctly (in case the developer adds a script before they
+      # remember to set the execute bit)
+      my ($file) = $line =~ qr/\AA.{8}\s*\d+\s+(.*)/msx;
+      if (!$file || !-f $file) {
+        next LINE;
+      }
+      my ($command, @arguments)
+        = (-x $file && !-l $file) ? ('propset', '*') : ('propdel');
+      $SVN->call($command, qw{-q svn:executable}, @arguments, $file);
+    }
+
+    # Abort commit if files are in conflict, missing, or out of date
+    my @keys = grep {@{$st_lines_of{$_}}} keys(%st_lines_of);
+    if (@keys) {
+      for my $key (sort(@keys)) {
+        my @lines = map {"$_\n"} @{$st_lines_of{$key}};
+        $CLI_MESSAGE->('ST_' . $key, join(q{}, @lines));
+      }
+      return _cm_abort(FCM1::Cm::Abort->FAIL);
+    }
+  }
+
+  # Read in any existing message
+  my $commit_message_ctx = $COMMIT_MESSAGE_UTIL->load();
+
+  # Execute "svn status" for a list of changed items
+  @status = map {$_ . "\n"} grep {$_ =~ qr/\A[^\?]/msx} _svn_status_get();
+
+  # Abort if there is no change in the working copy
+  if (!@status) {
+    return _cm_abort(FCM1::Cm::Abort->NULL);
+  }
+
+  # Abort if attempt to add commit message file
+  my $ci_mesg_file_base = $COMMIT_MESSAGE_UTIL->path_base();
+  my @bad_status = grep {$_ =~ qr{^A.*?\s$ci_mesg_file_base\n}m} @status;
+  if (@bad_status) {
+    for my $bad_status (@bad_status) {
+      $CLI_MESSAGE->('ST_CI_MESG_FILE', $bad_status);
+    }
+    return _cm_abort(FCM1::Cm::Abort->FAIL);
+  }
+
+  # Get associated URL of current working copy
+  my $layout = $SVN->get_layout($SVN->get_info()->[0]->{url});
+
+  # Include URL, or project, branch and sub-directory info in @status
+  unshift @status, "\n";
+
+  if ($layout->get_branch()) {
+    unshift(@status,
+      map {sprintf("[%-7s: %s]\n", @{$_})} (
+        ['Root'   , $layout->get_root()    ],
+        ['Project', $layout->get_project() ],
+        ['Branch' , $layout->get_branch()  ],
+        ['Sub-dir', $layout->get_sub_tree()],
+      ),
+    );
+  }
+  else {
+    unshift(@status,
+      map {sprintf("[%s: %s]\n", @{$_})} (
+        ['Root', $layout->get_root()],
+        ['Path', $layout->get_path()],
+      ),
+    );
+  }
+
+  # Use a temporary file to store the final commit log message
+  $commit_message_ctx->set_info_part(join(q{}, @status));
+  $COMMIT_MESSAGE_UTIL->edit($commit_message_ctx);
+  $COMMIT_MESSAGE_UTIL->notify($commit_message_ctx);
+
+  # Check with the user to see if he/she wants to go ahead
+  my $reply = 'n';
+  if (!defined($option_ref->{'dry-run'})) {
+    $reply = $CLI_PROMPT->('commit', (
+        $layout->is_trunk()         ? ('CI_TRUNK')
+      : !$layout->get_branch_owner()? ('CI')
+      : $layout->is_owned_by_user() ? ('CI')
+      : $layout->is_shared()        ? ('CI_BRANCH_SHARED',
+                                       $layout->get_branch_owner())
+      :                               ('CI_BRANCH_USER')
+    ));
+  }
+
+  if ($reply eq 'y') {
+    # Commit the change if user replies "y" for "yes"
+    my $temp = $COMMIT_MESSAGE_UTIL->temp($commit_message_ctx);
+    eval {$SVN->call(
+      qw{commit -F}, "$temp",
+      ($option_ref->{'svn-non-interactive'} ? '--non-interactive' : ()),
+      (   defined($option_ref->{password})
+          ? ('--password', $option_ref->{password}) : ()
+      ),
+    )};
+    if ($@) {
+      $COMMIT_MESSAGE_UTIL->save($commit_message_ctx);
+      die($@);
+    }
+
+    # Remove commit message file
+    unlink($COMMIT_MESSAGE_UTIL->path());
+
+    # Update the working copy
+    _svn_update();
+
+  } else {
+    $COMMIT_MESSAGE_UTIL->save($commit_message_ctx);
+    if (!$option_ref->{'dry-run'}) {
+      return _cm_abort();
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &FCM1::Cm::cm_merge ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn merge".
+# ------------------------------------------------------------------------------
+
+sub cm_merge {
+  my ($option_ref, @args) = @_;
+  # Find out the URL of the working copy
+  if (!is_wc()) {
+    return _cm_err(FCM1::Cm::Exception->INVALID_WC, '.');
+  }
+  my $wct = $SVN->get_wc_root();
+  if ($wct ne cwd()) {
+    chdir($wct) || return _cm_err(FCM1::Cm::Exception->CHDIR, $wct);
+    $CLI_MESSAGE->('CHDIR_WCT', $wct);
+  }
+  my $target = FCM1::CmBranch->new(URL => get_url_of_wc($wct));
+  if (!$target->url_exists()) {
+    return _cm_err(FCM1::Cm::Exception->WC_URL_NOT_EXIST, '.');
+  }
+
+  # The target must be at the top of a branch
+  # $subdir will be used later to determine whether the merge is allowed or not
+  my $subdir = $target->subdir();
+  if ($subdir) {
+    $target->url_peg($target->branch_url_peg());
+  }
+
+  # Check for any local modifications
+  # ----------------------------------------------------------------------------
+  if (!$option_ref->{'dry-run'} && !$option_ref->{'non-interactive'}) {
+    _svn_status_checker('merge', 'MODIFIED', $CLI_HANDLER_OF{WC_STATUS})->();
+  }
+
+  # Determine the SOURCE URL
+  # ----------------------------------------------------------------------------
+  my $source;
+
+  if ($option_ref->{reverse}) {
+    # Reverse merge, the SOURCE is the working copy URL
+    $source = FCM1::CmBranch->new (URL => $target->url);
+
+  } else {
+    # Automatic/custom merge, argument 1 is the SOURCE of the merge
+    my $source_url = shift (@args);
+    if (!$source_url) {
+      _cli_err('CLI_MERGE_ARG1');
+    }
+
+    $source = _cm_get_source($source_url, $target);
+  }
+
+  # Parse the revision option
+  # ----------------------------------------------------------------------------
+  my @revs
+    = (grep {$option_ref->{$_}} qw{reverse custom}) && $option_ref->{revision}
+    ? split(qr{:}xms, $option_ref->{revision})
+    : ();
+
+  # Determine the merge delta and the commit log message
+  # ----------------------------------------------------------------------------
+  my (@delta, $mesg, @logs);
+  my $separator = '-' x 80 . "\n";
+
+  if ($option_ref->{reverse}) {
+    # Reverse merge
+    # --------------------------------------------------------------------------
+    if (@revs == 0) {
+      my $last_commit_rev = $source->svninfo('FLAG' => 'commit:revision');
+      @revs = ($last_commit_rev, $last_commit_rev - 1);
+    }
+    elsif (@revs == 1) {
+      $revs[1] = ($revs[0] - 1);
+    }
+    else {
+      @revs = sort {$b <=> $a} @revs;
+    }
+
+    # "Delta" of the "svn merge" command
+    @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg);
+
+    # Template message
+    $mesg = 'Reversed r' . $revs[0];
+    if ($revs[1] < $revs[0] - 1) {
+      $mesg .= ':' . $revs[1];
+    }
+    if ($source->path()) {
+      $mesg .= ' of ' . $source->path();
+    }
+    $mesg .= "\n";
+
+  } elsif ($option_ref->{custom}) {
+    # Custom merge
+    # --------------------------------------------------------------------------
+    if (@revs) {
+      # Revision specified
+      # ------------------------------------------------------------------------
+      # Only one revision N specified, use (N - 1):N as the delta
+      unshift @revs, ($revs[0] - 1) if @revs == 1;
+      $source->url_peg(
+        $source->branch_url() . '/' . $subdir . '@' . $source->pegrev(),
+      );
+      $target->url_peg(
+        $target->branch_url() . '/' . $subdir . '@' . $target->pegrev(),
+      );
+
+      # "Delta" of the "svn merge" command
+      @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg);
+
+      # Template message
+      $mesg = 'Custom merge into ' . $target->path . ': r' . $revs[1] .
+              ' cf. r' . $revs[0] . ' of ' . $source->path_peg . "\n";
+
+    } else {
+      # Revision not specified
+      # ------------------------------------------------------------------------
+      # Get second source URL
+      my $source2_url = shift (@args);
+      if (!$source2_url) {
+        _cli_err('CLI_MERGE_ARG2');
+      }
+
+      my $source2 = _cm_get_source($source2_url, $target);
+      for my $item ($source, $source2, $target) {
+        $item->url_peg($item->branch_url() . '/' . $subdir . '@' . $item->pegrev());
+      }
+
+      # "Delta" of the "svn merge" command
+      @delta = ($source->url_peg, $source2->url_peg);
+
+      # Template message
+      $mesg = 'Custom merge into ' . $target->path . ': ' . $source->path_peg .
+              ' cf. ' . $source2->path_peg . "\n";
+    }
+
+  } else {
+    # Automatic merge
+    # --------------------------------------------------------------------------
+    # Check to ensure source branch is not the same as the target branch
+    if (!$target->branch()) {
+      return _cm_err(FCM1::Cm::Exception->WC_INVALID_BRANCH, $wct);
+    }
+    if ($source->branch() eq $target->branch()) {
+      return _cm_err(FCM1::Cm::Exception->MERGE_SELF, $target->url_peg(), $wct);
+    }
+
+    # Only allow the merge if the source and target are "directly related"
+    # --------------------------------------------------------------------------
+    my $anc = $target->ancestor ($source);
+    return _cm_err(
+      FCM1::Cm::Exception->MERGE_UNRELATED, $target->url_peg(), $source->url_peg
+    ) unless
+      ($anc->url eq $target->url and $anc->url_peg eq $source->parent->url_peg)
+      or
+      ($anc->url eq $source->url and $anc->url_peg eq $target->parent->url_peg)
+      or
+      ($anc->url eq $source->parent->url and $anc->url eq $target->parent->url);
+
+    # Check for available merges from the source
+    # --------------------------------------------------------------------------
+    my @revs = $target->avail_merge_from ($source, 1);
+
+    if (@revs) {
+      if ($option_ref->{verbose}) {
+        # Verbose mode, print log messages of available merges
+        $CLI_MESSAGE->('MERGE_REVS', $source->path_peg(), q{});
+        for (@revs) {
+          $CLI_MESSAGE->('SEPARATOR');
+          $CLI_MESSAGE->(q{}, $source->display_svnlog($_));
+        }
+        $CLI_MESSAGE->('SEPARATOR');
+      }
+      else {
+        # Normal mode, list revisions of available merges
+        $CLI_MESSAGE->('MERGE_REVS', $source->path_peg(), join(q{ }, @revs));
+      }
+
+    } else {
+      return _cm_abort(FCM1::Cm::Abort->NULL);
+    }
+
+    # If more than one merge available, prompt user to enter a revision number
+    # to merge from, default to $revs [0]
+    # --------------------------------------------------------------------------
+    if ($option_ref->{'non-interactive'} || @revs == 1) {
+      $source->url_peg($source->url() . '@' . $revs[0]);
+    }
+    else {
+      my $reply = $CLI_PROMPT->(
+        {type => q{}, default => $revs[0]}, 'merge', 'MERGE_REV',
+      );
+      if (!defined($reply)) {
+        return _cm_abort();
+      }
+      # Expand revision keyword if necessary
+      if ($reply) {
+        $reply = (FCM1::Keyword::expand($target->project_url(), $reply))[1];
+      }
+      # Check that the reply is a number in the available merges list
+      if (!grep {$_ eq $reply} @revs) {
+        return _cm_err(FCM1::Cm::Exception->MERGE_REV_INVALID, $reply)
+      }
+      $source->url_peg($source->url() . '@' . $reply);
+    }
+
+    # If the working copy top is pointing to a sub-directory of a branch,
+    # we need to check whether the merge will result in losing changes made in
+    # other sub-directories of the source.
+    if ($subdir and not $target->allow_subdir_merge_from ($source, $subdir)) {
+      return _cm_err(FCM1::Cm::Exception->MERGE_UNSAFE, $source->url_peg());
+    }
+
+    # Calculate the base of the merge
+    my $base = $target->base_of_merge_from ($source);
+
+    # $source and $base must take into account the sub-directory
+    my $source_full = FCM1::CmBranch->new (URL => $source->url_peg);
+    my $base_full = FCM1::CmBranch->new (URL => $base->url_peg);
+
+    if ($subdir) {
+      $source_full->url_peg(
+        $source_full->branch_url() . '/' . $subdir . '@' . $source_full->pegrev()
+      );
+      $base_full->url_peg(
+        $base_full->branch_url() . '/' . $subdir . '@' . $base_full->pegrev()
+      );
+    }
+
+    # Diagnostic
+    $CLI_MESSAGE->('SEPARATOR'); 
+    $CLI_MESSAGE->('MERGE_COMPARE', $source->path_peg(), $base->path_peg()); 
+    # Delta of the "svn merge" command
+    @delta = ($base_full->url_peg, $source_full->url_peg);
+
+    # Template message
+    $mesg = sprintf(
+      "Merged into %s: %s cf. %s",
+      $target->path(), $source->path_peg(), $base->path_peg(),
+    );
+
+    if (exists($option_ref->{'auto-log'})) {
+      my $last_merge_from_source = ($target->last_merge_from($source))[1];
+      if (!defined($last_merge_from_source)) {
+        $last_merge_from_source = $target->ancestor($source);
+      }
+      my %log_entries = $source->svnlog(
+        REV => [$last_merge_from_source->pegrev() + 1, $source->pegrev()],
+      );
+      @logs = sort {$b->{'revision'} <=> $a->{'revision'}} values(%log_entries);
+    }
+  }
+
+  # Run "svn merge" in "--dry-run" mode to see the result
+  # ----------------------------------------------------------------------------
+  my $dry_run_output
+    = $SVN->stdout(qw{svn merge --dry-run --non-interactive}, @delta);
+
+  # Abort merge if it will result in no change
+  if (!$dry_run_output) {
+    return _cm_abort(FCM1::Cm::Abort->NULL);
+  }
+
+  # Report result of "svn merge --dry-run"
+  if ($option_ref->{'dry-run'} || !$option_ref->{'non-interactive'}) {
+    $CLI_MESSAGE->('MERGE_DRYRUN', $dry_run_output);
+  }
+
+  return if $option_ref->{'dry-run'};
+
+  # Prompt the user to see if (s)he would like to go ahead
+  # ----------------------------------------------------------------------------
+  # Go ahead with merge only if user replies "y"
+  if (
+    !$option_ref->{'non-interactive'} && $CLI_PROMPT->('merge', 'MERGE') ne 'y'
+  ) {
+    return _cm_abort();
+  }
+  $SVN->call('cleanup');
+  my $output = $SVN->stdout(qw{svn merge --non-interactive}, @delta);
+  $CLI_MESSAGE->('MERGE_OK');
+  if ($output ne $dry_run_output) {
+    $CLI_MESSAGE->('MERGE_ACTUAL', $output);
+  }
+
+  # Prepare the commit log
+  # ----------------------------------------------------------------------------
+  my $commit_message_ctx = $COMMIT_MESSAGE_UTIL->load();
+  my @auto_log = map {
+    my $log_entry = $_;
+    my @msg_list = (
+      map  {q{> } . $_}
+      grep {
+            $_
+        &&  $_ !~ qr{\AMerged\sinto\s\S+:\s(?:\S+)\scf\.\s(?:\S+)\z}msx
+        &&  $_ !~ qr{\A(?:\#\d+(?:,\#\d+)*:\s)?Created\s\S+\sfrom\s\S+\.\z}msx
+        &&  $_ !~ qr{\Ar\d+:\z}msx
+        &&  $_ !~ qr{\A>\s.+\z}msx
+      }
+      split("\n", $log_entry->{'msg'})
+    );
+    @msg_list ? ('----', 'r' . $log_entry->{'revision'} . ':', @msg_list) : ();
+  } @logs;
+  my @messages = (
+    $mesg,
+    (@auto_log ? (@auto_log, '----'): ()),
+    $commit_message_ctx->get_auto_part()
+  );
+  $commit_message_ctx->set_auto_part(join("\n", @messages));
+  $COMMIT_MESSAGE_UTIL->save($commit_message_ctx);
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &FCM1::Cm::cm_mkpatch ();
+#
+# DESCRIPTION
+#   This is a FCM command to create a patching script from particular revisions
+#   of a URL.
+# ------------------------------------------------------------------------------
+
+sub cm_mkpatch {
+  my ($option_ref, $u, $outdir) = @_;
+  # Process command line options and arguments
+  my @exclude = $option_ref->{exclude} ? @{$option_ref->{exclude}} : ();
+  my $organisation = $option_ref->{organisation};
+  my $revision = $option_ref->{revision};
+
+  # Excluded paths, convert glob into regular patterns
+  @exclude = split (/:/, join (':', @exclude));
+  for (@exclude) {
+    s#\*#[^/]*#; # match any number of non-slash character
+    s#\?#[^/]#;  # match a non-slash character
+    s#/*$##;     # remove trailing slash
+  }
+
+  # Organisation prefix
+  $organisation ||= 'original';
+
+  # Make sure revision option is set correctly
+  my @revs = $revision ? split (/:/, $revision) : ();
+  @revs    = @revs [0, 1] if @revs > 2;
+
+  if (!$u) {
+    _cli_err('CLI_USAGE', 'URL');
+  }
+
+  my $url = FCM1::CmUrl->new (URL => $u);
+  if (!$url->is_url()) {
+    return _cm_err(FCM1::Cm::Exception->INVALID_URL, $u);
+  }
+  if (!$url->url_exists()) {
+    return _cm_err(FCM1::Cm::Exception->NOT_EXIST, $u);
+  }
+  if (!$url->branch()) {
+    $CLI_MESSAGE->('INVALID_BRANCH', $u);
+  }
+  elsif ($url->subdir()) {
+    $CLI_MESSAGE->('BRANCH_SUBDIR', $u);
+  }
+
+  if (@revs) {
+    # If HEAD revision is given, convert it into a number
+    # --------------------------------------------------------------------------
+    for my $rev (@revs) {
+      $rev = $url->svninfo(FLAG => 'revision') if uc ($rev) eq 'HEAD';
+    }
+
+  } else {
+    # If no revision is given, use the HEAD
+    # --------------------------------------------------------------------------
+    $revs[0] = $url->svninfo(FLAG => 'revision');
+  }
+
+  $revs[1] = $revs[0] if @revs == 1;
+
+  # Check that output directory is set
+  # ----------------------------------------------------------------------------
+  $outdir = File::Spec->catfile (cwd (), 'fcm-mkpatch-out') if not $outdir;
+
+  if (-e $outdir) {
+    # Ask user to confirm removal of old output directory if it exists
+    if ($CLI_PROMPT->('mkpatch', 'MKPATCH_OVERWRITE', $outdir) ne 'y') {
+      return _cm_abort();
+    }
+
+    rmtree($outdir) || return _cm_err(FCM1::Cm::Exception->RMTREE, $outdir);
+  }
+
+  # (Re-)create output directory
+  mkpath($outdir) || return _cm_err(FCM1::Cm::Exception->MKPATH, $outdir);
+  $CLI_MESSAGE->('OUT_DIR', $outdir);
+
+  # Get and process log of URL
+  # ----------------------------------------------------------------------------
+  my @script   = (); # main output script
+  my %log      = $url->svnlog (REV => \@revs);
+  my $url_path = $url->path;
+
+  for my $rev (sort {$a <=> $b} keys %log) {
+    # Look at the changed paths for each revision
+    my $use_patch     = 1; # OK to use a patch file?
+    my $only_modified = 1; # Change only contains modifications?
+    my @paths;
+    PATH: for my $path (sort keys %{ $log{$rev}{paths} }) {
+      my $file = $path;
+
+      # Skip paths outside of the branch
+      next PATH unless $file =~ s#^$url_path/##;
+
+      # Skip excluded paths
+      for my $exclude (@exclude) {
+        if ($file =~ m#^$exclude(?:/|$)#) {
+          # Can't use a patch file if any files have been excluded
+          $use_patch = 0;
+          next PATH;
+        }
+      }
+
+      # Can't use a patch file if any files have been added or replaced
+      $use_patch = 0 if $log{$rev}{paths}{$path}{action} eq 'A' or
+                        $log{$rev}{paths}{$path}{action} eq 'R';
+
+      $only_modified = 0 unless $log{$rev}{paths}{$path}{action} eq 'M';
+
+      push @paths, $path;
+    }
+
+    # If the change only contains modifications, make sure they aren't
+    # just property changes
+    if ($only_modified) {
+      my @changedpaths;
+      for my $path (@paths) {
+        (my $file = $path) =~ s#^$url_path/*##;
+        my @diff = $SVN->stdout(
+          qw{svn diff --no-diff-deleted --summarize -c}, $rev,
+          sprintf("%s/%s@%s", $url->url(), $file, $rev),
+        );
+        next unless $diff[-1] =~ /^[A-Z]/;
+        push @changedpaths, $path;
+      }
+      @paths = @changedpaths;
+    }
+
+    next unless @paths;
+
+    # Create the patch using "svn diff"
+    my $patch = ();
+    if ($use_patch) {
+      $patch = $SVN->stdout(
+          qw{svn diff --no-diff-deleted -c}, $rev, $url->url(),
+      );
+      if ($patch) {
+        # Don't use the patch if it may contain subversion keywords or
+        # any changes to PDF files or any changes to symbolic links or
+        # any carriage returns in the middle of a line
+        for (split(qr{\n}msx, $patch)) {
+          if (/\$[a-zA-Z:]+ *\$/ or /^--- .+\.pdf\t/ or /^\+link / or /\r.+/) {
+            $use_patch = 0;
+            last;
+          }
+        }
+      } else {
+        $use_patch = 0;
+      }
+    }
+
+    # Create a directory for this revision in the output directory
+    my $outdir_rev = File::Spec->catfile ($outdir, $rev);
+    mkpath($outdir_rev)
+      || return _cm_err(FCM1::Cm::Exception->MKPATH, $outdir_rev);
+
+    # Parse commit log message
+    my @msg = split /\n/, $log{$rev}{msg};
+    for (@msg) {
+      # Re-instate line break
+      $_ .= "\n";
+
+      # Remove line if it matches a merge template
+      $_ = '' if /^Reversed r\d+(?::\d+)? of \S+$/;
+      $_ = '' if /^Custom merge into \S+:.+$/;
+      $_ = '' if /^Merged into \S+: \S+ cf\. \S+$/;
+
+      # Modify Trac ticket link
+      s/(?:#|ticket:)(\d+)/${organisation}_ticket:$1/g;
+
+      # Modify Trac changeset link
+      s/(?:r|changeset:)(\d+)/${organisation}_changeset:$1/g;
+      s/\[(\d+)\]/${organisation}_changeset:$1/g;
+    }
+
+    push @msg, '(' . $organisation . '_changeset:' . $rev . ')' . "\n";
+
+    # Write commit log message in a file
+    my $f_revlog = File::Spec->catfile ($outdir_rev, 'log-message');
+    open FILE, '>', $f_revlog or die $f_revlog, ': cannot open (', $!, ')';
+    print FILE @msg;
+    close FILE or die $f_revlog, ': cannot close (', $!, ')';
+
+    # Handle each changed path
+    my $export_file   = 1;  # name for next exported file (gets incremented)
+    my $patch_needed  = 0;  # is a patch file required?
+    my @before_script = (); # patch script to run before patch applied
+    my @after_script  = (); # patch script to run after patch applied
+    my @copied_dirs   = (); # copied directories
+    CHANGED: for my $path (@paths) {
+      (my $file = $path) =~ s#^$url_path/*##;
+      my $url_file = $url->url . '/' . $file . '@' . $rev;
+
+      # Skip paths within copied directories
+      for my $copied_dir (@copied_dirs) {
+        next CHANGED if $file =~ m#^$copied_dir(?:/|$)#;
+      }
+
+      # Handle deleted files
+      if ($log{$rev}{paths}{$path}{action} eq 'D') {
+        push @after_script, 'svn delete "' . $file . '"';
+
+      } else {
+        # Skip property changes (if not done earlier)
+        if (not $only_modified and $log{$rev}{paths}{$path}{action} eq 'M') {
+          my @diff = $SVN->stdout(
+            qw{svn diff --no-diff-deleted --summarize -c}, $rev, $url_file,
+          );
+          next CHANGED unless $diff[-1] =~ /^[A-Z]/;
+        }
+
+        # Determine if the file is a directory
+        my $is_dir
+          =     $log{$rev}{paths}{$path}{action} ne 'M'
+            &&  $SVN->get_info($url_file)->[0]->{'kind'} eq 'dir';
+
+        # Decide how to treat added files
+        my $export_required = 0;
+        if ($log{$rev}{paths}{$path}{action} eq 'A') {
+          my $is_newfile = 0;
+          # Determine if the file is copied
+          if (exists $log{$rev}{paths}{$path}{'copyfrom-path'}) {
+            if ($is_dir) {
+              # A copied directory needs to be exported and added recursively
+              push @after_script, 'svn add "' . $file . '"';
+              $export_required = 1;
+              push @copied_dirs, $file;
+            } else {
+              # History exists for this file
+              my $copyfrom_path = $log{$rev}{paths}{$path}{'copyfrom-path'};
+              my $copyfrom_rev  = $log{$rev}{paths}{$path}{'copyfrom-rev'};
+              my $cp_url = FCM1::CmUrl->new (
+                URL => $url->root . $copyfrom_path . '@' . $copyfrom_rev,
+              );
+
+              if ($copyfrom_path =~ s#^$url_path/*##) {
+                # File is copied from a file under the specified URL
+                # Check source exists
+                $is_newfile = 1 unless $cp_url->url_exists ($rev - 1);
+              } else {
+                # File copied from outside of the specified URL
+                $is_newfile = 1;
+
+                # Check branches can be determined
+                if ($url->branch and $cp_url->branch) {
+
+                  # Follow its history, stop on copy
+                  my %cp_log = $cp_url->svnlog (STOP_ON_COPY => 1);
+
+                  # "First" revision of the copied file
+                  my $cp_rev = (sort {$a <=> $b} keys %cp_log) [0];
+                  my %attrib = %{ $cp_log{$cp_rev}{paths}{$cp_url->path} }
+                    if $cp_log{$cp_rev}{paths}{$cp_url->path};
+
+                  # Check whether the "first" revision is copied from elsewhere.
+                  if (exists $attrib{'copyfrom-path'}) {
+                    # If source exists in the specified URL, set up the copy
+                    my $cp_cp_url = FCM1::CmUrl->new (
+                      URL => $url->root . $attrib{'copyfrom-path'} . '@' .
+                             $attrib{'copyfrom-rev'},
+                    );
+                    if ($cp_cp_url->subdir()) {
+                      $cp_cp_url->url_peg(
+                        $cp_cp_url->project_url()
+                        . '/' . $url->branch()
+                        . '/' . $cp_cp_url->subdir()
+                        . '@' . $cp_cp_url->pegrev(),
+                      );
+                      if ($cp_cp_url->url_exists ($rev - 1)) {
+                        ($copyfrom_path = $cp_cp_url->path) =~ s#^$url_path/*##;
+                        # Check path is defined - if not it probably means the
+                        # branch doesn't follow the FCM naming convention
+                        $is_newfile = 0 if $copyfrom_path;
+                      }
+                    }
+                  }
+
+                  # Note: The logic above does not cover all cases. However, it
+                  # should do the right thing for the most common case. Even
+                  # where it gets it wrong the file contents should always be
+                  # correct even if the file history is not.
+                }
+              }
+
+              # Check whether file is copied from an excluded or copied path
+              if (not $is_newfile) {
+                for my $path (@exclude,@copied_dirs) {
+                  if ($copyfrom_path =~ m#^$path(?:/|$)#) {
+                    $is_newfile = 1;
+                    last;
+                  }
+                }
+              }
+
+              # Check whether file is copied from a file which has been replaced
+              if (not $is_newfile) {
+                my $copyfrom_fullpath = $url->branch_path . "/" . $copyfrom_path;
+                $is_newfile = 1 if ($log{$rev}{paths}{$copyfrom_fullpath}{action} and
+                                    $log{$rev}{paths}{$copyfrom_fullpath}{action} eq 'R');
+              }
+
+              # Copy the file, if required
+              push @before_script, 'svn copy ' . $copyfrom_path .  ' "' . $file . '"'
+                if not $is_newfile;
+            }
+
+          } else {
+            # History does not exist, must be a new file
+            if ($is_dir) {
+              # If it's a directory then create it and add it immediately
+              # (in case it contains any copied files)
+              push @before_script, 'mkdir "' . $file. '"';
+              push @before_script, 'svn add "' . $file . '"';
+            } else {
+              $is_newfile = 1;
+	    }
+          }
+
+          # Add the file, if required
+          if ($is_newfile) {
+            push @after_script, 'svn add "' . $file . '"';
+          }
+        }
+
+        if ($is_dir and $log{$rev}{paths}{$path}{action} eq 'R') {
+          # Subversion does not appear to support replacing a directory in a
+          # single transaction from a working copy (other than as the result
+          # of a merge). Therefore the delete of the old directory must be
+          # done in advance as a separate commit.
+          push @script, 'svn delete -m "Delete directory in preparation for' .
+            ' replacing it (part of ' . $organisation . '_changeset:' . $rev .
+            ')" $target/' . $file;
+          push @script, 'svn update --non-interactive';
+          # The replaced directory needs to be exported and added recursively
+          push @after_script, 'svn add "' . $file . '"';
+          $export_required = 1;
+          push @copied_dirs, $file;
+        }
+
+        if (not $is_dir and $log{$rev}{paths}{$path}{action} ne 'A') {
+          my ($was_symlink) = $SVN->stdout(
+            qw{svn propget svn:special},
+            sprintf("%s/%s@%d", $url->url(), $file, ($rev - 1)),
+          );
+          my ($is_symlink) = $SVN->stdout(
+            qw{svn propget svn:special}, $url_file,
+          );
+          if ($was_symlink and not $is_symlink) {
+            # A symbolic link has been changed to a normal file
+            push @before_script, 'svn propdel -q svn:special "' . $file . '"';
+            push @before_script, 'rm "' . $file . '"';
+	  } elsif ($log{$rev}{paths}{$path}{action} eq 'R') {
+            # Delete the old file and then add the new file
+            push @before_script, 'svn delete "' . $file . '"';
+            push @after_script, 'svn add "' . $file . '"';
+          } elsif ($is_symlink and not $was_symlink) {
+            # A normal file has been changed to a symbolic link
+            push @after_script, 'svn propset -q svn:special \* "' . $file . '"';
+          } elsif ($is_symlink and $was_symlink) {
+            # If a symbolic link has been modified then remove the old
+            # copy first to allow the copy to work
+            push @before_script, 'rm "' . $file . '"';
+          }
+        }
+
+        # Decide whether the file needs to be exported
+        if (not $is_dir) {
+          if (not $use_patch) {
+            $export_required = 1;
+          } else {
+            # Export the file if it is binary
+            my @file_diff = $SVN->stdout(
+              qw{svn diff --no-diff-deleted -c}, $rev, $url_file,
+            );
+            for (@file_diff) {
+              $export_required = 1 if /Cannot display: file marked as a binary type./;
+            }
+            # Only create a patch file if necessary
+            $patch_needed = 1 if not $export_required;
+          }
+        }
+
+        if ($export_required) {
+          # Download the file using "svn export"
+          my $export = File::Spec->catfile ($outdir_rev, $export_file);
+          $SVN->call(qw{export -q -r}, $rev, $url_file, $export);
+
+          # Copy the exported file into the file
+          push @before_script,
+               'cp -r ${fcm_patch_dir}/' . $export_file . ' "' . $file . '"';
+          $export_file++;
+        }
+      }
+    }
+
+    # Write the patch file
+    if ($patch_needed) {
+      my $patchfile = File::Spec->catfile ($outdir_rev, 'patchfile');
+      open FILE, '>', $patchfile
+        or die $patchfile, ': cannot open (', $!, ')';
+      print FILE $patch;
+      close FILE or die $patchfile, ': cannot close (', $!, ')';
+    }
+
+    # Add line break to each line in @before_script and @after_script
+    @before_script = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")}
+                     @before_script if (@before_script);
+    @after_script  = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")}
+                     @after_script if (@after_script);
+
+    # Write patch script to output
+    my $out = File::Spec->catfile ($outdir_rev, 'apply-patch');
+    open FILE, '>', $out or die $out, ': cannot open (', $!, ')';
+
+    # Script header
+    print FILE <<EOF;
+#!/usr/bin/env bash
+# ------------------------------------------------------------------------------
+# NAME
+#   apply-patch
+#
+# DESCRIPTION
+#   This script is generated automatically by the "fcm mkpatch" command. It
+#   applies the patch to the current working directory which must be a working
+#   copy of a valid project tree that can accept the import of the patches.
+#
+#   Patch created from $organisation URL: $u
+#   Changeset: $rev
+# ------------------------------------------------------------------------------
+
+this=`basename \$0`
+echo "\$this: Applying patch for changeset $rev."
+
+# Location of the patch, base on the location of this script
+cd `dirname \$0` || exit 1
+fcm_patch_dir=\$PWD
+
+# Change directory back to the working copy
+cd \$OLDPWD || exit 1
+
+# Check working copy does not have local changes
+status=`svn status`
+if [[ -n \$status ]]; then
+  echo "\$this: working copy contains changes, abort." >&2
+  exit 1
+fi
+if [[ -a "#commit_message#" ]]; then
+  echo "\$this: existing commit message in "#commit_message#", abort." >&2
+  exit 1
+fi
+
+# Apply the changes
+patch_command=\${patch_command:-"patch --no-backup-if-mismatch -p0"}
+EOF
+
+    # Script content
+    print FILE @before_script if @before_script;
+    print FILE "\$patch_command <\${fcm_patch_dir}/patchfile || exit 1\n"
+      if $patch_needed;
+    print FILE @after_script  if @after_script;
+
+    # Script footer
+    print FILE <<EOF;
+
+# Copy in the commit message
+cp \${fcm_patch_dir}/log-message "#commit_message#"
+
+echo "\$this: finished normally."
+#EOF
+EOF
+
+    close FILE or die $out, ': cannot close (', $!, ')';
+
+    # Add executable permission
+    chmod 0755, $out;
+
+    # Script to commit the change
+    push @script, '${fcm_patches_dir}/' . $rev . '/apply-patch';
+    push @script, 'svn commit -F "#commit_message#"';
+    push @script, 'rm -f "#commit_message#"';
+    push @script, 'svn update --non-interactive';
+    push @script, '';
+
+    $CLI_MESSAGE->('PATCH_REV', $rev);
+  }
+
+  # Write the main output script if necessary. Otherwise remove output directory
+  # ----------------------------------------------------------------------------
+  if (@script) {
+    # Add line break to each line in @script
+    @script = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")} @script;
+
+    # Write script to output
+    my $out = File::Spec->catfile ($outdir, 'fcm-import-patch');
+    open FILE, '>', $out or die $out, ': cannot open (', $!, ')';
+
+    # Script header
+    print FILE <<EOF;
+#!/usr/bin/env bash
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm-import-patch
+#
+# SYNOPSIS
+#   fcm-import-patch TARGET
+#
+# DESCRIPTION
+#   This script is generated automatically by the "fcm mkpatch" command, as are
+#   the revision "patches" created in the same directory. The script imports the
+#   patches into TARGET, which must either be a URL or a working copy of a valid
+#   project tree that can accept the import of the patches.
+#
+#   Patch created from $organisation URL: $u
+# ------------------------------------------------------------------------------
+
+this=`basename \$0`
+
+# Check argument
+target=\$1
+
+# First argument must be a URL or working copy
+if [[ -z \$target ]]; then
+  echo "\$this: the first argument must be a URL or a working copy, abort." >&2
+  exit 1
+fi
+
+if [[ \$target == svn://*  || \$target == svn+ssh://* || \\
+      \$target == http://* || \$target == https://*   || \\
+      \$target == file://* ]]; then
+  # A URL, checkout a working copy in a temporary location
+  fcm_tmp_dir=`mktemp -d \${TMPDIR:=/tmp}/\$this.XXXXXX`
+  fcm_working_copy=\$fcm_tmp_dir
+  svn checkout -q \$target \$fcm_working_copy || exit 1
+else
+  fcm_working_copy=\$target
+  target=`svn info \$fcm_working_copy | grep "^URL: " | sed 's/URL: //'` || exit 1
+fi
+
+# Location of the patches, base on the location of this script
+cd `dirname \$0` || exit 1
+fcm_patches_dir=\$PWD
+
+# Change directory to the working copy
+cd \$fcm_working_copy || exit 1
+
+# Set the language to avoid encoding problems
+if locale -a | grep -q en_GB\$; then
+  export LANG=en_GB
+fi
+
+# Commands to apply patches
+EOF
+
+    # Script content
+    print FILE @script;
+
+    # Script footer
+    print FILE <<EOF;
+# Check working copy does not have local changes
+status=`svn status`
+if [[ -n \$status ]]; then
+  echo "\$this: working copy still contains changes, abort." >&2
+  exit 1
+fi
+
+# Remove temporary working copy, if necessary
+if [[ -d \$fcm_tmp_dir && -w \$fcm_tmp_dir ]]; then
+  rm -rf \$fcm_tmp_dir
+fi
+
+echo "\$this: finished normally."
+#EOF
+EOF
+
+    close FILE or die $out, ': cannot close (', $!, ')';
+
+    # Add executable permission
+    chmod 0755, $out;
+
+    # Diagnostic
+    $CLI_MESSAGE->('PATCH_DONE', $outdir);
+
+  } else {
+    # Remove output directory
+    rmtree $outdir or die $outdir, ': cannot remove';
+
+    # Diagnostic
+    return _cm_abort(FCM1::Cm::Abort->NULL);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# CLI error.
+sub _cli_err {
+    my ($key, @args) = @_;
+    my $message = sprintf($CLI_MESSAGE_FOR_ERROR{$key}, @args);
+    die(FCM1::CLI::Exception->new({message => $message}));
+}
+
+# ------------------------------------------------------------------------------
+# The default handler of the "WC_STATUS" event.
+sub _cli_handler_of_wc_status {
+    my ($name, $target_list_ref, $status_list_ref) = @_;
+    $target_list_ref ||= [q{.}];
+    if (@{$status_list_ref}) {
+        $CLI_MESSAGE->(
+            'STATUS',
+            $name,
+            q{"} . join(q{", "}, @{$target_list_ref}) . q{"},
+            join("\n", @{$status_list_ref}),
+        );
+        if ($CLI_PROMPT->($name, 'CONTINUE', $name) ne 'y') {
+            return _cm_abort();
+        }
+    }
+    return @{$status_list_ref};
+}
+
+# ------------------------------------------------------------------------------
+# The default handler of the "WC_STATUS_PATH" event.
+sub _cli_handler_of_wc_status_path {
+    my ($name, $target_list_ref, $status_list_ref) = @_;
+    my $message
+        = @{$status_list_ref} ? (join("\n", @{$status_list_ref}) . "\n") : q{};
+    $CLI_MESSAGE->(q{}, $message);
+    my @paths = map {chomp(); ($_ =~ $PATTERN_OF{ST_PATH})} @{$status_list_ref};
+    my @paths_of_interest;
+    while (my $path = shift(@paths)) {
+        my %handler_of = (
+            a => sub {push(@paths_of_interest, $path, @paths); @paths = ()},
+            n => sub {},
+            y => sub {push(@paths_of_interest, $path)},
+        );
+        my $reply = $CLI_PROMPT->(
+            {type => 'yna'}, $name, 'RUN_SVN_COMMAND', "$name $path",
+        );
+        $handler_of{$reply}->();
+    }
+    return @paths_of_interest;
+}
+
+# ------------------------------------------------------------------------------
+# Expands location keywords in a list.
+sub _cli_keyword_expand_url {
+    my ($arg_list_ref) = @_;
+    ARG:
+    for my $arg (@{$arg_list_ref}) {
+        my ($label, $value) = ($arg =~ $PATTERN_OF{CLI_OPT});
+        if (!$label) {
+            ($label, $value) = (q{}, $arg);
+        }
+        if (!$value) {
+            next ARG;
+        }
+        eval {
+            $value = FCM1::Util::tidy_url(FCM1::Keyword::expand($value));
+        };
+        if ($@) {
+            if ($value ne 'fcm:revision') {
+                die($@);
+            }
+        }
+        $arg = $label . $value;
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Expands revision keywords in -r and --revision options in a list.
+sub _cli_keyword_expand_rev {
+    my ($arg_list_ref) = @_;
+    my @targets;
+    for my $arg (@{$arg_list_ref}) {
+        if (-e $arg && is_wc($arg) || is_url($arg)) {
+            push(@targets, $arg);
+        }
+    }
+    if (!@targets) {
+        push(@targets, get_url_of_wc());
+    }
+    if (!@targets) {
+        return;
+    }
+    my @old_arg_list = @{$arg_list_ref};
+    my @new_arg_list = ();
+    ARG:
+    while (defined(my $arg = shift(@old_arg_list))) {
+        my ($key, $value) = $arg =~ $PATTERN_OF{CLI_OPT_REV};
+        if (!$key) {
+            push(@new_arg_list, $arg);
+            next ARG;
+        }
+        push(@new_arg_list, '--revision');
+        if (!$value) {
+            $value = shift(@old_arg_list);
+        }
+        my @revs = grep {defined()} ($value =~ $PATTERN_OF{CLI_OPT_REV_RANGE});
+        my ($url, @url_list) = @targets;
+        for my $rev (@revs) {
+            if ($rev !~ $PATTERN_OF{SVN_REV}) {
+                $rev = (FCM1::Keyword::expand($url, $rev))[1];
+            }
+            if (@url_list) {
+                $url = shift(@url_list);
+            }
+        }
+        push(@new_arg_list, join(q{:}, @revs));
+    }
+    @{$arg_list_ref} = @new_arg_list;
+}
+
+# ------------------------------------------------------------------------------
+# Prints a message.
+sub _cli_message {
+    my ($key, @args) = @_;
+    for (
+        [\*STDOUT, \%CLI_MESSAGE_FOR        , q{}          ],
+        [\*STDERR, \%CLI_MESSAGE_FOR_WARNING, q{[WARNING] }],
+        [\*STDERR, \%CLI_MESSAGE_FOR_ABORT  , q{[ABORT] }  ],
+        [\*STDERR, \%CLI_MESSAGE_FOR_ERROR  , q{[ERROR] }  ],
+    ) {
+        my ($handle, $hash_ref, $prefix) = @{$_};
+        if (exists($hash_ref->{$key})) {
+            return printf({$handle} $prefix . $hash_ref->{$key}, @args);
+        }
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Wrapper for FCM1::Interactive::get_input.
+sub _cli_prompt {
+    my %option
+        = (type => 'yn', default => 'n', (ref($_[0]) ? %{shift(@_)} : ()));
+    my ($name, $key, @args) = @_;
+    return FCM1::Interactive::get_input(
+        title   => $CLI_PROMPT_PREFIX . $name,
+        message => sprintf($CLI_MESSAGE_FOR_PROMPT{$key}, @args),
+        %option,
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Check missing status and delete.
+sub cm_check_missing {
+    my %option = %{shift()};
+    my $checker
+        = _svn_status_checker('delete', 'MISSING', $option{st_check_handler});
+    my @paths = $checker->(\@_);
+    if (@paths) {
+        $SVN->call('delete', @paths);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Check unknown status and add.
+sub cm_check_unknown {
+    my %option = %{shift()};
+    my $checker
+        = _svn_status_checker('add', 'UNKNOWN', $option{st_check_handler});
+    my @paths = $checker->(\@_);
+    if (@paths) {
+        $SVN->call('add', @paths);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# FCM wrapper to SVN switch.
+sub cm_switch {
+    my %option = %{shift()};
+    my ($source, $path) = @_;
+    $path ||= cwd();
+    if (!$source) {
+        return _cm_err(FCM1::Cm::Exception->INVALID_TARGET, q{});
+    }
+    if (!-e $path) {
+        return _cm_err(FCM1::Cm::Exception->NOT_EXIST, $path);
+    }
+    if (!is_wc($path)) {
+        return _cm_err(FCM1::Cm::Exception->INVALID_WC, $path);
+    }
+
+    # Check for merge template in the commit log file in the working copy
+    my $path_of_wc = $SVN->get_wc_root($path);
+    my $commit_message_file = $COMMIT_MESSAGE_UTIL->path($path_of_wc);
+    my $commit_message_ctx = $COMMIT_MESSAGE_UTIL->load($commit_message_file);
+    if ($commit_message_ctx->get_auto_part()) {
+        return _cm_err(
+            FCM1::Cm::Exception->SWITCH_UNSAFE,
+            ($path eq $path_of_wc
+                ? File::Spec->abs2rel($commit_message_file)
+                : $commit_message_file
+            ),
+        );
+    }
+
+    # Check for any local modifications
+    if (defined($option{st_check_handler})) {
+        _svn_status_checker('switch', 'MODIFIED', $option{st_check_handler})->(
+            [$path_of_wc],
+        );
+    }
+
+    my @targets = $path_of_wc eq cwd() ? () : ($path_of_wc);
+    $SVN->call('cleanup', @targets);
+    $SVN->call(
+        'switch',
+        '--non-interactive',
+        ($option{revision} ? ('-r', $option{revision}) : ()),
+        ($option{quiet}    ? '--quiet'                 : ()),
+        _cm_get_source(
+            $source,
+            FCM1::CmBranch->new(URL => $path_of_wc),
+        )->url_peg(),
+        @targets,
+    );
+}
+
+# ------------------------------------------------------------------------------
+# FCM wrapper to SVN update.
+sub cm_update {
+    my %option = %{shift()};
+    my @targets = @_;
+    if (!@targets) {
+        @targets = (cwd());
+    }
+    for my $target (@targets) {
+        if (!-e $target) {
+            return _cm_err(FCM1::Cm::Exception->NOT_EXIST, $target);
+        }
+        if (!is_wc($target)) {
+            return _cm_err(FCM1::Cm::Exception->INVALID_WC, $target);
+        }
+        $target = $SVN->get_wc_root($target);
+        if ($target eq cwd()) {
+            $target = q{.};
+        }
+    }
+    if (defined($option{st_check_handler})) {
+        my ($matcher_keys_ref, $show_updates)
+            = defined($option{revision}) ? (['MODIFIED'       ], undef)
+            :                              (['MODIFIED', 'OOD'], 1    )
+            ;
+        my $matcher = sub {
+            for my $key (@{$matcher_keys_ref}) {
+                $ST_MATCHER_FOR{$key}->(@_) && return 1;
+            }
+        };
+        _svn_status_checker(
+            'update', $matcher, $option{st_check_handler}, $show_updates,
+        )->(\@targets);
+    }
+    if ($option{revision} && $option{revision} !~ $PATTERN_OF{SVN_REV}) {
+        $option{revision} = (
+            FCM1::Keyword::expand(get_url_of_wc($targets[0]), $option{revision})
+        )[1];
+    }
+    _svn_update(\@targets, \%option);
+}
+
+# ------------------------------------------------------------------------------
+# Raises an abort exception.
+sub _cm_abort {
+    my ($code) = @_;
+    $code ||= FCM1::Cm::Abort->USER;
+    die(bless({code => $code, message => 'abort'}, 'FCM1::Cm::Abort'));
+}
+
+# ------------------------------------------------------------------------------
+# Raises a failure.
+sub _cm_err {
+    my ($code, @targets) = @_;
+    die(bless(
+        {code => $code, message => "ERROR: $code", targets => \@targets},
+        'FCM1::Cm::Exception',
+    ));
+}
+
+# ------------------------------------------------------------------------------
+# Return a corresponding FCM1::CmBranch instance for $source_url w.r.t. $target.
+sub _cm_get_source {
+    my ($source_url, $target) = @_;
+    if (!$UTIL->uri_match($source_url)) {
+        # Source not full URL, construct source URL based on target URL
+        my ($path, $peg) = $source_url =~ qr{\A(.*?)(@[^@/]+)?\z}msx;
+        my $project = $target->project_path();
+        if (index($path, $project . '/') == 0) {
+            # $path contains the full path under the repository root
+            $path = substr($path, length($project));
+        }
+        my %layout_config = %{$target->layout()->get_config()};
+        if (!grep {!defined($layout_config{"dir-$_"})} qw{trunk branch tag}) {
+            # $path must be under the specified sub-directories for the trunk,
+            # branches and tags
+            my @dirs = map {$layout_config{"dir-$_"}} qw{trunk branch tag};
+            my @paths = split(qr{/+}msx, $path);
+            if (!@paths || !grep {$_ eq $paths[0]} @dirs) {
+                $path = $layout_config{'dir-branch'} . '/' . $path;
+            }
+        }
+        $peg ||= q{};
+        $source_url = join('/', $target->project_url(), $path) . $peg;
+    }
+    my $source = FCM1::CmBranch->new(URL => $source_url);
+    my $layout = eval {$source->layout()};
+    if ($@) {
+        $@ = undef;
+        return _cm_err(FCM1::Cm::Exception->INVALID_URL, $source_url);
+    }
+    if (!$layout->get_branch()) {
+        return _cm_err(FCM1::Cm::Exception->INVALID_BRANCH, $source_url);
+    }
+    $source->url_peg(
+        $source->branch_url()
+        . ($target->subdir() ? '/' . $target->subdir() : q{})
+        . ('@' . $source->pegrev())
+    );
+    # Ensure that the source and target URLs are in the same project
+    if ($source->project_url() ne $target->project_url()) {
+        return _cm_err(
+            FCM1::Cm::Exception->DIFF_PROJECTS,
+            $target->url_peg(),
+            $source->url_peg(),
+        );
+    }
+    return $source;
+}
+
+# ------------------------------------------------------------------------------
+# Returns the results of "svn status".
+sub _svn_status_get {
+    my ($targets_ref, $show_updates) = @_;
+    my @targets = (defined($targets_ref) ? @{$targets_ref} : ());
+    for my $target (@targets) {
+        if ($target eq cwd()) {
+            $target = q{.};
+        }
+    }
+    my @options = ($show_updates ? qw{--show-updates} : ());
+    $SVN->stdout(qw{svn status --ignore-externals}, @options, @targets);
+}
+
+# ------------------------------------------------------------------------------
+# Returns a "svn status" checker.
+sub _svn_status_checker {
+    my ($name, $matcher, $handler, $show_updates) = @_;
+    if (!ref($matcher)) {
+        $matcher = $ST_MATCHER_FOR{$matcher};
+    }
+    my $P = $PATTERN_OF{ST_PATH};
+    sub {
+        my ($targets_ref) = @_;
+        my @status = _svn_status_get($targets_ref, $show_updates);
+        if ($show_updates) {
+            @status = map {$_ =~ $PATTERN_OF{ST_AGAINST_REV} ? () : $_} @status;
+        }
+        my @status_of_interest = grep {$matcher->($_)} @status;
+        # Note: for future expansion...
+        #my @paths;
+        #if (!$show_updates) {
+        #    @paths = map {chomp(); $_} map {($_ =~ $P)} @status_of_interest;
+        #}
+        #defined($handler)
+        #? $handler->($name, $targets_ref, \@status_of_interest, \@paths)
+        #: @status_of_interest
+        #;
+        defined($handler)
+        ? $handler->($name, $targets_ref, \@status_of_interest)
+        : @status_of_interest
+        ;
+    };
+}
+
+# ------------------------------------------------------------------------------
+# Runs "svn update".
+sub _svn_update {
+    my ($targets_ref, $option_hash_ref) = @_;
+    my %option = (defined($option_hash_ref) ? %{$option_hash_ref} : ());
+    my @targets = defined($targets_ref) ? @{$targets_ref} : ();
+    $SVN->call('cleanup', @targets);
+    $SVN->call(
+        'update',
+        '--non-interactive',
+        ($option{revision} ? ('-r', $option{revision}) : ()),
+        ($option{quiet}    ? '--quiet'                 : ()),
+        @targets,
+    );
+}
+
+# ------------------------------------------------------------------------------
+# CLI exception.
+package FCM1::CLI::Exception;
+use base qw{FCM1::Exception};
+
+# ------------------------------------------------------------------------------
+# Abort exception.
+package FCM1::Cm::Abort;
+use base qw{FCM1::Exception};
+use constant {FAIL => 'FAIL', NULL => 'NULL', USER => 'USER'};
+
+sub get_code {
+    return $_[0]->{code};
+}
+
+# ------------------------------------------------------------------------------
+# Resource exception.
+package FCM1::Cm::Exception;
+our @ISA = qw{FCM1::Cm::Abort};
+use constant {
+    CHDIR             => 'CHDIR',
+    DIFF_PROJECTS     => 'DIFF_PROJECTS',
+    INVALID_BRANCH    => 'INVALID_BRANCH',
+    INVALID_PROJECT   => 'INVALID_PROJECT',
+    INVALID_TARGET    => 'INVALID_TARGET',
+    INVALID_URL       => 'INVALID_URL',
+    INVALID_WC        => 'INVALID_WC',
+    MERGE_REV_INVALID => 'MERGE_REV_INVALID',
+    MERGE_SELF        => 'MERGE_SELF',
+    MERGE_UNRELATED   => 'MERGE_UNRELATED',
+    MERGE_UNSAFE      => 'MERGE_UNSAFE',
+    MKPATH            => 'MKPATH',
+    NOT_EXIST         => 'NOT_EXIST',
+    PARENT_NOT_EXIST  => 'PARENT_NOT_EXIST',
+    RMTREE            => 'RMTREE',
+    SWITCH_UNSAFE     => 'SWITCH_UNSAFE',
+    WC_INVALID_BRANCH => 'WC_INVALID_BRANCH',
+    WC_URL_NOT_EXIST  => 'WC_URL_NOT_EXIST',
+};
+
+sub get_targets {
+    return @{$_[0]->{targets}};
+}
+
+1;
+__END__
+
+=pod
+
+=head1 NAME
+
+FCM1::Cm
+
+=head1 SYNOPSIS
+
+    use FCM1::Cm qw{cm_check_missing cm_check_unknown cm_switch cm_update};
+
+    # Checks status for "missing" items and "svn delete" them
+    $missing_st_handler = sub {
+        my ($name, $targets_ref, $status_list_ref) = @_;
+        # ...
+        return @paths_of_interest;
+    };
+    cm_check_missing({st_check_handler => $missing_st_handler}, @targets);
+
+    # Checks status for "unknown" items and "svn add" them
+    $unknown_st_handler = sub {
+        my ($name, $targets_ref, $status_list_ref) = @_;
+        # ...
+        return @paths_of_interest;
+    };
+    cm_check_unknown({st_check_handler => $unknown_st_handler}, @targets);
+
+    # Sets up a status checker
+    $st_check_handler = sub {
+        my ($name, $targets_ref, $status_list_ref) = @_;
+        # ...
+    };
+    # Switches a "working copy" at the "root" level to a new URL target
+    cm_switch(
+        {
+            'non-interactive'  => $non_interactive_flag,
+            'quiet'            => $quiet_flag,
+            'revision'         => $revision,
+            'st_check_handler' => $st_check_handler,
+        },
+        $target, $path_of_wc,
+    );
+    # Runs "svn update" on each working copy from their "root" level
+    cm_update(
+        {
+            'non-interactive'  => $non_interactive_flag,
+            'quiet'            => $quiet_flag,
+            'revision'         => $revision,
+            'st_check_handler' => $st_check_handler,
+        },
+        @targets,
+    );
+
+=head1 DESCRIPTION
+
+Wraps the Subversion client and implements other FCM code management
+functionalities.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item cm_check_missing(\%option,@targets)
+
+Use "svn status" to check for missing items in @targets. If @targets is an empty
+list, the function adds the current working directory to it. Expects
+$option{st_check_handler} to be a CODE reference. Calls
+$option{st_check_handler} with ($name, $targets_ref, $status_list_ref) where
+$name is "delete", $targets_ref is \@targets, and $status_list_ref is an
+ARRAY reference to a list of "svn status" output with the "missing" status.
+$option{st_check_handler} should return a list of interesting paths, which will
+be scheduled for removal using "svn delete".
+
+=item cm_check_unknown(\%option,@targets)
+
+Similar to cm_check_missing(\%option,@targets) but checks for "unknown" items,
+which will be scheduled for addition using "svn add".
+
+=item cm_switch(\%option,$target,$path_of_wc)
+
+Invokes "svn switch" at the root of a working copy specified by $path_of_wc (or
+the current working directory if $path_of_wc is not specified).
+$option{'non-interactive'}, $option{quiet}, $option{revision} determines the
+options (of the same name) that are passed to "svn switch". If
+$option{st_check_handler} is set, it should be a CODE reference, and will be
+called with ('switch', [$path_of_wc], $status_list_ref), where $status_list_ref
+is an ARRAY reference to the output returned by "svn status" on $path_of_wc.
+This can be used for the application to display the working copy status to the
+user before prompting him/her to continue. The return value of
+$option{st_check_handler} is ignored.
+
+=item cm_update(\%option,@targets)
+
+Invokes "svn update" at the root of each working copy specified by @targets. If
+@targets is an empty list, the function adds the current working directory to
+it. $option{'non-interactive'}, $option{quiet}, $option{revision} determines the
+options (of the same name) that are passed to "svn update". If
+$option{st_check_handler} is set, it should be a CODE reference, and will be
+called with ($name, $targets_ref, $status_list_ref), where $name is
+'update', $targets_ref is \@targets and $status_list_ref is an ARRAY
+reference to the output returned by "svn status -u" on the @targets. This can be
+used for the application to display the working copy update status to the user
+before prompting him/her to continue. The return value of
+$option{st_check_handler} is ignored.
+
+=back
+
+=head1 DIAGNOSTICS
+
+The following exceptions can be raised:
+
+=over 4
+
+=item FCM1::Cm::Abort
+
+This exception @ISA L<FCM1::Exception|FCM1::Exception>. It is raised if a command
+is aborted for some reason. The $e->get_code() method can be used to retrieve an
+error code, which can be one of the following:
+
+=over 4
+
+=item $e->FAIL
+
+The command aborts because of a failure.
+
+=item $e->NULL
+
+The command aborts because it will result in no change.
+
+=item $e->USER
+
+The command aborts because of an action by the user.
+
+=back
+
+=item FCM1::Cm::Exception
+
+This exception @ISA L<FCM1::Abort|FCM1::Abort>. It is raised if a command fails
+with a known reason. The $e->get_targets() method can be used to retrieve a list
+of targets/resources associated with this exception. The $e->get_code() method
+can be used to retrieve an error code, which can be one of the following:
+
+=over 4
+
+=item $e->CHDIR
+
+Fails to change directory to a target.
+
+=item $e->INVALID_BRANCH
+
+A target is not a valid branch URL in the standard FCM project layout.
+
+=item $e->INVALID_PROJECT
+
+A target is not a valid project URL in the standard FCM project layout.
+
+=item $e->INVALID_TARGET
+
+A target is not a valid Subversion URL or working copy.
+
+=item $e->INVALID_URL
+
+A target is not a valid Subversion URL.
+
+=item $e->INVALID_WC
+
+A target is not a valid Subversion working copy.
+
+=item $e->MERGE_REV_INVALID
+
+An invalid revision (target element 0) is specified for a merge.
+
+=item $e->MERGE_SELF
+
+Attempt to merge a URL (target element 0) to its own working copy (target
+element 1).
+
+=item $e->MERGE_UNRELATED
+
+The merge target (target element 0) is not directly related to the merge source
+(target element 1).
+
+=item $e->MERGE_UNSAFE
+
+A merge source (target element 0) contains changes outside the target
+sub-directory.
+
+=item $e->MKPATH
+
+Fail to create a directory (target element 0) recursively.
+
+=item $e->NOT_EXIST
+
+A target does not exist.
+
+=item $e->PARENT_NOT_EXIST
+
+The parent of the target no longer exists.
+
+=item $e->RMTREE
+
+Fail to remove a directory (target element 0) recursively.
+
+=item $e->SWITCH_UNSAFE
+
+A merge template exists in the commit message file (target element 0) in a
+working copy target.
+
+=item $e->WC_INVALID_BRANCH
+
+The URL of the target working copy is not a valid branch URL in the standard FCM
+project layout.
+
+=item $e->WC_URL_NOT_EXIST
+
+The URL of the target working copy no longer exists at the HEAD revision.
+
+=back
+
+=back
+
+=head1 TO DO
+
+Reintegrate with L<FCM1::CmUrl|FCM1::CmUrl> and L<FCM1::CmBranch|FCM1::CmBranch>,
+but separate this module into the CLI part and the CM part. Expose the remaining
+CM functions when this is done.
+
+Use L<SVN::Client|SVN::Client> to interface with Subversion.
+
+Move C<mkpatch> out of this module.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
+opy already exists.
+
+=item $e->WC_INVALID_BRANCH
+
+The URL of the target working copy is not a valid branch URL in the standard FCM
+project layout.
+
+=item $e->WC_URL_NOT_EXIST
+
+The URL of the target working copy no longer exists at the HEAD revision.
+
+=back
+
+=back
+
+=head1 TO DO
+
+Reintegrate with L<FCM1::CmUrl|FCM1::CmUrl> and L<FCM1::CmBranch|FCM1::CmBranch>,
+but separate this module into the CLI part and the CM part. Expose the remaining
+CM functions when this is done.
+
+Use L<SVN::Client|SVN::Client> to interface with Subversion.
+
+Move C<mkpatch> out of this module.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
+$e->CHDIR
+
+Fails to change directory to a target.
+
+=item $e->INVALID_BRANCH
+
+A target is not a valid branch URL in the standard FCM project layout.
+
+=item $e->INVALID_PROJECT
+
+A target is not a valid project URL in the standard FCM project layout.
+
+=item $e->INVALID_TARGET
+
+A target is not a valid Subversion URL or working copy.
+
+=item $e->INVALID_URL
+
+A target is not a valid Subversion URL.
+
+=item $e->INVALID_WC
+
+A target is not a valid Subversion working copy.
+
+=item $e->MERGE_REV_INVALID
+
+An invalid revision (target element 0) is specified for a merge.
+
+=item $e->MERGE_SELF
+
+Attempt to merge a URL (target element 0) to its own working copy (target
+element 1).
+
+=item $e->MERGE_UNRELATED
+
+The merge target (target element 0) is not directly related to the merge source
+(target element 1).
+
+=item $e->MERGE_UNSAFE
+
+A merge source (target element 0) contains changes outside the target
+sub-directory.
+
+=item $e->MKPATH
+
+Fail to create a directory (target element 0) recursively.
+
+=item $e->NOT_EXIST
+
+A target does not exist.
+
+=item $e->PARENT_NOT_EXIST
+
+The parent of the target no longer exists.
+
+=item $e->RMTREE
+
+Fail to remove a directory (target element 0) recursively.
+
+=item $e->SWITCH_UNSAFE
+
+A merge template exists in the commit message file (target element 0) in a
+working copy target.
+
+=item $e->WC_INVALID_BRANCH
+
+The URL of the target working copy is not a valid branch URL in the standard FCM
+project layout.
+
+=item $e->WC_URL_NOT_EXIST
+
+The URL of the target working copy no longer exists at the HEAD revision.
+
+=back
+
+=back
+
+=head1 TO DO
+
+Migrate to FCM::System hierarchy.
+
+Move C<mkpatch> out of this module.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/CmBranch.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/CmBranch.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/CmBranch.pm	(revision 5095)
@@ -0,0 +1,1009 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::CmBranch
+#
+# DESCRIPTION
+#   This class contains methods for manipulating a branch. It is a sub-class of
+#   FCM1::CmUrl, and inherits all methods from that class.
+#
+# ------------------------------------------------------------------------------
+
+package FCM1::CmBranch;
+use base qw{FCM1::CmUrl};
+
+use strict;
+use warnings;
+
+use FCM1::Config;
+use FCM1::Interactive;
+use FCM1::Keyword;
+use FCM1::Util qw/e_report w_report svn_date/;
+
+my @properties = (
+  'CREATE_REV',  # revision at which the branch is created
+  'DELETE_REV',  # revision at which the branch is deleted
+  'PARENT',      # reference to parent branch FCM1::CmBranch
+  'ANCESTOR',    # list of common ancestors with other branches
+                 # key = URL, value = ancestor FCM1::CmBranch
+  'LAST_MERGE',  # list of last merges from branches
+                 # key = URL@REV, value = [TARGET, UPPER, LOWER]
+  'AVAIL_MERGE', # list of available revisions for merging
+                 # key = URL@REV, value = [REV ...]
+  'CHILDREN',    # list of children of this branch
+  'SIBLINGS',    # list of siblings of this branch
+);
+
+# Set the commit message utility provided by FCM::System::CM.
+our $COMMIT_MESSAGE_UTIL;
+sub set_commit_message_util {
+    $COMMIT_MESSAGE_UTIL = shift();
+}
+
+# Set the SVN utility provided by FCM::System::CM.
+our $SVN;
+sub set_svn_util {
+    $SVN = shift();
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch = FCM1::CmBranch->new (URL => $url,);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::CmBranch class.
+#
+# ARGUMENTS
+#   URL    - URL of a branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = FCM1::CmUrl->new (%args);
+
+  $self->{$_} = undef for (@properties);
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_branch->url_peg;
+#   $cm_branch->url_peg ($url);
+#
+# DESCRIPTION
+#   This method returns/sets the current URL.
+# ------------------------------------------------------------------------------
+
+sub url_peg {
+  my $self = shift;
+
+  if (@_) {
+    if (! $self->{URL} or $_[0] ne $self->{URL}) {
+      # Re-set URL and other essential variables in the SUPER-class
+      $self->SUPER::url_peg (@_);
+
+      # Re-set essential variables
+      $self->{$_} = undef for (@properties);
+    }
+  }
+
+  return $self->{URL};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_branch->create_rev;
+#
+# DESCRIPTION
+#   This method returns the revision at which the branch was created.
+# ------------------------------------------------------------------------------
+
+sub create_rev {
+  my $self = shift;
+
+  if (not $self->{CREATE_REV}) {
+    return unless $self->url_exists ($self->pegrev);
+
+    # Use "svn log" to find out the first revision of the branch
+    my %log = $self->svnlog (STOP_ON_COPY => 1);
+
+    # Look at log in ascending order
+    my $rev   = (sort {$a <=> $b} keys %log) [0];
+    my $paths = $log{$rev}{paths};
+
+    # Get revision when URL is first added to the repository
+    if (exists $paths->{$self->branch_path}) {
+      $self->{CREATE_REV} = $rev if $paths->{$self->branch_path}{action} eq 'A';
+    }
+  }
+
+  return $self->{CREATE_REV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $parent = $cm_branch->parent;
+#
+# DESCRIPTION
+#   This method returns the parent (a FCM1::CmBranch object) of the current
+#   branch.
+# ------------------------------------------------------------------------------
+
+sub parent {
+  my $self = shift;
+
+  if (not $self->{PARENT}) {
+    # Use the log to find out the parent revision
+    my %log = $self->svnlog (REV => $self->create_rev);
+
+    if (exists $log{paths}{$self->branch_path}) {
+      my $path = $log{paths}{$self->branch_path};
+
+      if ($path->{action} eq 'A') {
+        if (exists $path->{'copyfrom-path'}) {
+          # Current branch is copied from somewhere, set the source as the parent
+          my $url = $self->root .  $path->{'copyfrom-path'};
+          my $rev = $path->{'copyfrom-rev'};
+          $self->{PARENT} = FCM1::CmBranch->new (URL => $url . '@' . $rev);
+
+        } else {
+          # Current branch is not copied from somewhere
+          $self->{PARENT} = $self;
+        }
+      }
+    }
+  }
+
+  return $self->{PARENT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_branch->delete_rev;
+#
+# DESCRIPTION
+#   This method returns the revision at which the branch was deleted.
+# ------------------------------------------------------------------------------
+
+sub delete_rev {
+  my $self = shift;
+
+  if (not $self->{DELETE_REV}) {
+    return if $self->url_exists ('HEAD');
+
+    # Container of the current URL
+    (my $dir_url = $self->branch_url) =~ s#/+[^/]+/*$##;
+
+    # Use "svn log" on the container between a revision where the branch exists
+    # and the HEAD
+    my $dir = FCM1::CmUrl->new (URL => $dir_url);
+    my %log = $dir->svnlog (
+      REV => ['HEAD', ($self->pegrev ? $self->pegrev : $self->create_rev)],
+    );
+
+    # Go through the log to see when branch no longer exists
+    for my $rev (sort {$a <=> $b} keys %log) {
+      next unless exists $log{$rev}{paths}{$self->branch_path} and
+                  $log{$rev}{paths}{$self->branch_path}{action} eq 'D';
+
+      $self->{DELETE_REV} = $rev;
+      last;
+    }
+  }
+
+  return $self->{DELETE_REV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->is_child_of ($branch);
+#
+# DESCRIPTION
+#   This method returns true if the current branch is a child of $branch.
+# ------------------------------------------------------------------------------
+
+sub is_child_of {
+  my ($self, $branch) = @_;
+  !$self->is_trunk()
+    && $self->parent()->url() eq $branch->url()
+    && (!$branch->is_branch() || $self->create_rev() >= $branch->create_rev());
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->is_sibling_of ($branch);
+#
+# DESCRIPTION
+#   This method returns true if the current branch is a sibling of $branch.
+# ------------------------------------------------------------------------------
+
+sub is_sibling_of {
+  my ($self, $branch) = @_;
+
+  # The trunk cannot be a sibling branch
+  return if $branch->is_trunk;
+
+  return if $self->parent->url ne $branch->parent->url;
+
+  # If the parent is a branch, ensure they are actually the same branch
+  return if $branch->parent->is_branch and
+            $self->parent->create_rev != $branch->parent->create_rev;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_relatives ($relation);
+#
+# DESCRIPTION
+#   This method sets the $self->{$relation} variable by inspecting the list of
+#   branches at the current revision of the current branch. $relation can be
+#   either "CHILDREN" or "SIBLINGS".
+# ------------------------------------------------------------------------------
+
+sub _get_relatives {
+  my ($self, $relation) = @_;
+
+  $self->{$relation} = [];
+
+  # If we are searching for CHILDREN, get list of SIBLINGS, and vice versa
+  my $other = ($relation eq 'CHILDREN' ? 'SIBLINGS' : 'CHILDREN');
+  my %other_list;
+  if ($self->{$other}) {
+    %other_list = map {$_->url(), 1} @{$self->{$other}};
+  }
+
+  my @url_peg_list = $self->branch_list();
+  URL:
+  for my $url_peg (@url_peg_list) {
+    my ($url, $peg) = $SVN->split_by_peg($url_peg);
+    # Ignore URL of current branch and its parent
+    if ( $url eq $self->url()
+         # Ignore parent
+      || $self->is_branch() && $url eq $self->parent()->url()
+         # Ignore the other type of relatives
+      || exists($other_list{$url})
+    ) {
+      next URL;
+    }
+
+    my $branch = FCM1::CmBranch->new(URL => $url_peg);
+
+    # Test whether $branch is a relative we are looking for
+    my $can_return = $relation eq 'CHILDREN'
+      ? $branch->is_child_of($self) : $branch->is_sibling_of($self);
+    if ($can_return) {
+      push(@{$self->{$relation}}, $branch);
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @children = $cm_branch->children;
+#
+# DESCRIPTION
+#   This method returns a list of children (FCM1::CmBranch objects) of the
+#   current branch that exists in the current revision.
+# ------------------------------------------------------------------------------
+
+sub children {
+  my $self = shift;
+
+  $self->_get_relatives ('CHILDREN') if not $self->{CHILDREN};
+
+  return @{ $self->{CHILDREN} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @siblings = $cm_branch->siblings;
+#
+# DESCRIPTION
+#   This method returns a list of siblings (FCM1::CmBranch objects) of the
+#   current branch that exists in the current revision.
+# ------------------------------------------------------------------------------
+
+sub siblings {
+  my $self = shift;
+
+  $self->_get_relatives ('SIBLINGS') if not $self->{SIBLINGS};
+
+  return @{ $self->{SIBLINGS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ancestor = $cm_branch->ancestor ($branch);
+#
+# DESCRIPTION
+#   This method returns the common ancestor (a FCM1::CmBranch object) of a
+#   specified $branch and the current branch. The argument $branch must be a
+#   FCM1::CmBranch object. Both the current branch and $branch are assumed to be
+#   in the same project.
+# ------------------------------------------------------------------------------
+
+sub ancestor {
+  my ($self, $branch) = @_;
+
+  if (not exists $self->{ANCESTOR}{$branch->url_peg}) {
+    if ($self->url_peg eq $branch->url_peg) {
+      $self->{ANCESTOR}{$branch->url_peg} = $self;
+
+    } else {
+      # Get family tree of current branch, from trunk to current branch
+      my @this_family = ($self);
+      while (not $this_family [0]->is_trunk) {
+        unshift @this_family, $this_family [0]->parent;
+      }
+
+      # Get family tree of $branch, from trunk to $branch
+      my @that_family = ($branch);
+      while (not $that_family [0]->is_trunk) {
+        unshift @that_family, $that_family [0]->parent;
+      }
+
+      # Find common ancestor from list of parents
+      my $ancestor = undef;
+
+      while (not $ancestor) {
+        # $this and $that should both start as some revisions on the trunk.
+        # Walk down a generation each time it loops around.
+        my $this = shift @this_family;
+        my $that = shift @that_family;
+
+        if ($this->url eq $that->url) {
+          if ($this->is_trunk or $this->create_rev eq $that->create_rev) {
+            # $this and $that are the same branch
+            if (@this_family and @that_family) {
+              # More generations in both branches, try comparing the next
+              # generations.
+              next;
+
+            } else {
+              # End of lineage in one of the branches, ancestor is at the lower
+              # revision of the current URL.
+              if ($this->pegrev and $that->pegrev) {
+                $ancestor = $this->pegrev < $that->pegrev ? $this : $that;
+
+              } else {
+                $ancestor = $this->pegrev ? $this : $that;
+              }
+            }
+
+          } else {
+            # Despite the same URL, $this and $that are different branches as
+            # they are created at different revisions. The ancestor must be the
+            # parent with the lower revision. (This should not occur at the
+            # start.)
+            $ancestor = $this->parent->pegrev < $that->parent->pegrev
+                        ? $this->parent : $that->parent;
+          }
+
+        } else {
+          # Different URLs, ancestor must be the parent with the lower revision.
+          # (This should not occur at the start.)
+          $ancestor = $this->parent->pegrev < $that->parent->pegrev
+                      ? $this->parent : $that->parent;
+        }
+      }
+
+      $self->{ANCESTOR}{$branch->url_peg} = $ancestor;
+    }
+  }
+
+  return $self->{ANCESTOR}{$branch->url_peg};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($target, $upper, $lower) = $cm_branch->last_merge_from (
+#     $branch, $stop_on_copy,
+#   );
+#
+# DESCRIPTION
+#   This method returns a 3-element list with information of the last merge
+#   into the current branch from a specified $branch. The first element in the
+#   list $target (a FCM1::CmBranch object) is the target at which the merge was
+#   performed. (This can be the current branch or a parent branch up to the
+#   common ancestor with the specified $branch.) The second and third elements,
+#   $upper and $lower, (both FCM1::CmBranch objects), are the upper and lower
+#   ends of the source delta. If there is no merge from $branch into the
+#   current branch from their common ancestor to the current revision, this
+#   method will return an empty list. If $stop_on_copy is specified, it ignores
+#   merges from parents of $branch, and merges into parents of the current
+#   branch.
+# ------------------------------------------------------------------------------
+
+sub last_merge_from {
+  my ($self, $branch, $stop_on_copy) = @_;
+
+  if (not exists $self->{LAST_MERGE}{$branch->url_peg}) {
+    # Get "log" of current branch down to the common ancestor
+    my %log = $self->svnlog (
+      REV => [
+       ($self->pegrev ? $self->pegrev : 'HEAD'),
+       $self->ancestor ($branch)->pegrev,
+      ],
+
+      STOP_ON_COPY => $stop_on_copy,
+    );
+
+    my $cr = $self;
+
+    # Go down the revision log, checking for merge template messages
+    REV: for my $rev (sort {$b <=> $a} keys %log) {
+      # Loop each line of the log message at each revision
+      my @msg = split /\n/, $log{$rev}{msg};
+
+      # Also consider merges into parents of current branch
+      $cr = $cr->parent if ($cr->is_branch and $rev < $cr->create_rev);
+
+      for (@msg) {
+        # Ignore unless log message matches a merge template
+        next unless /Merged into \S+: (\S+) cf\. (\S+)/;
+
+        # Upper $1 and lower $2 ends of the source delta
+        my $u_path = $1;
+        my $l_path = $2;
+
+        # Add the root directory to the paths if necessary
+        $u_path = '/' . $u_path if substr ($u_path, 0, 1) ne '/';
+        $l_path = '/' . $l_path if substr ($l_path, 0, 1) ne '/';
+
+        # Only consider merges with specified branch (and its parent)
+        (my $path = $u_path) =~ s/@(\d+)$//;
+        my $u_rev = $1;
+
+        my $br = $branch;
+        $br    = $br->parent while (
+          $br->is_branch and $u_rev < $br->create_rev and not $stop_on_copy
+        );
+
+        next unless $br->branch_path eq $path;
+
+        # If $br is a parent of branch, ignore those merges with the parent
+        # above the branch point of the current branch
+        next if $br->pegrev and $br->pegrev < $u_rev;
+
+        # Set the return values
+        $self->{LAST_MERGE}{$branch->url_peg} = [
+          FCM1::CmBranch->new (URL => $cr->url . '@' . $rev), # target
+          FCM1::CmBranch->new (URL => $self->root . $u_path), # delta upper
+          FCM1::CmBranch->new (URL => $self->root . $l_path), # delta lower
+        ];
+
+        last REV;
+      }
+    }
+  }
+
+  return (exists $self->{LAST_MERGE}{$branch->url_peg}
+          ? @{ $self->{LAST_MERGE}{$branch->url_peg} } : ());
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @revs = $cm_branch->avail_merge_from ($branch[, $stop_on_copy]);
+#
+# DESCRIPTION
+#   This method returns a list of revisions of a specified $branch, which are
+#   available for merging into the current branch. If $stop_on_copy is
+#   specified, it will not list available merges from the parents of $branch.
+# ------------------------------------------------------------------------------
+
+sub avail_merge_from {
+  my ($self, $branch, $stop_on_copy) = @_;
+
+  if (not exists $self->{AVAIL_MERGE}{$branch->url_peg}) {
+    # Find out the revision of the upper delta at the last merge from $branch
+    # If no merge is found, use revision of common ancestor with $branch
+    my @last_merge = $self->last_merge_from ($branch);
+    my $rev        = $self->ancestor ($branch)->pegrev;
+    $rev           = $last_merge [1]->pegrev
+      if @last_merge and $last_merge [1]->pegrev > $rev;
+
+    # Get the "log" of the $branch down to $rev
+    my %log = $branch->svnlog (
+      REV          => [($branch->pegrev ? $branch->pegrev : 'HEAD'), $rev],
+      STOP_ON_COPY => $stop_on_copy,
+    );
+
+    # No need to include $rev itself, as it has already been merged
+    delete $log{$rev};
+
+    # No need to include the branch create revision
+    delete $log{$branch->create_rev}
+      if $branch->is_branch and exists $log{$branch->create_rev};
+
+    if (keys %log) {
+      # Check whether there is a latest merge from $self into $branch, if so,
+      # all revisions of $branch below that merge should become unavailable
+      my @last_merge_into = $branch->last_merge_from ($self);
+
+      if (@last_merge_into) {
+        for my $rev (keys %log) {
+          delete $log{$rev} if $rev < $last_merge_into [0]->pegrev;
+        }
+      }
+    }
+
+    # Available merges include all revisions above the branch creation revision
+    # or the revision of the last merge
+    $self->{AVAIL_MERGE}{$branch->url_peg} = [sort {$b <=> $a} keys %log];
+  }
+
+  return @{ $self->{AVAIL_MERGE}{$branch->url_peg} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $lower = $cm_branch->base_of_merge_from ($branch);
+#
+# DESCRIPTION
+#   This method returns the lower delta (a FCM1::CmBranch object) for the next
+#   merge from $branch.
+# ------------------------------------------------------------------------------
+
+sub base_of_merge_from {
+  my ($self, $branch) = @_;
+
+  # Base is the ancestor if there is no merge between $self and $branch
+  my $return = $self->ancestor ($branch);
+
+  # Get configuration for the last merge from $branch to $self
+  my @merge_from = $self->last_merge_from ($branch);
+
+  # Use the upper delta of the last merge from $branch, as all revisions below
+  # that have already been merged into the $self
+  $return = $merge_from [1]
+    if @merge_from and $merge_from [1]->pegrev > $return->pegrev;
+
+  # Get configuration for the last merge from $self to $branch
+  my @merge_into = $branch->last_merge_from ($self);
+
+  # Use the upper delta of the last merge from $self, as the current revision
+  # of $branch already contains changes of $self up to the peg revision of the
+  # upper delta
+  $return = $merge_into [1]
+    if @merge_into and $merge_into [0]->pegrev > $return->pegrev;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->allow_subdir_merge_from ($branch, $subdir);
+#
+# DESCRIPTION
+#   This method returns true if a merge from the sub-directory $subdir in
+#   $branch  is allowed - i.e. it does not result in losing changes made in
+#   $branch outside of $subdir.
+# ------------------------------------------------------------------------------
+
+sub allow_subdir_merge_from {
+  my ($self, $branch, $subdir) = @_;
+
+  # Get revision at last merge from $branch or ancestor
+  my @merge_from = $self->last_merge_from ($branch);
+  my $last       = @merge_from ? $merge_from [1] : $self->ancestor ($branch);
+  my $rev        = $last->pegrev;
+
+  my $return = 1;
+  if ($branch->pegrev > $rev) {
+    # Use "svn diff --summarize" to work out what's changed between last
+    # merge/ancestor and current revision
+    my $range = $branch->pegrev . ':' . $rev;
+    my @out = $SVN->stdout(
+        qw{svn diff --summarize -r}, $range, $branch->url_peg(),
+    );
+
+    # Returns false if there are changes outside of $subdir
+    my $url = join ('/', $branch->url, $subdir);
+    for my $line (@out) {
+      chomp $line;
+      $line = substr ($line, 7); # file name begins at column 7
+      if ($line !~ m#^$url(?:/|$)#) {
+        $return = 0;
+        last;
+      }
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->delete (
+#     [NON_INTERACTIVE     => 1,]
+#     [PASSWORD            => $password,]
+#     [SVN_NON_INTERACTIVE => 1,]
+#   );
+#
+# DESCRIPTION
+#   This method deletes the current branch from the Subversion repository.
+#
+# OPTIONS
+#   NON_INTERACTIVE     - Do no interactive prompting, set SVN_NON_INTERACTIVE
+#                         to true automatically.
+#   PASSWORD            - specify the password for commit access.
+#   SVN_NON_INTERACTIVE - Do no interactive prompting when running svn commit,
+#                         etc. This option is implied by NON_INTERACTIVE.
+# ------------------------------------------------------------------------------
+
+sub del {
+  my $self = shift;
+  my %args = @_;
+
+  # Options
+  # ----------------------------------------------------------------------------
+  my $password            = exists $args{PASSWORD} ? $args{PASSWORD} : undef;
+  my $non_interactive     = exists $args{NON_INTERACTIVE}
+                            ? $args{NON_INTERACTIVE} : 0;
+  my $svn_non_interactive = exists $args{SVN_NON_INTERACTIVE}
+                            ? $args{SVN_NON_INTERACTIVE} : 0;
+  $svn_non_interactive    = $non_interactive ? 1 : $svn_non_interactive;
+
+  # Ensure URL is a branch
+  # ----------------------------------------------------------------------------
+  e_report $self->url_peg, ': not a branch, abort.' if not $self->is_branch;
+
+  # Create a temporary file for the commit log message
+  my $temp_handle = $self->_commit_message(
+    sprintf("Deleted %s.\n", $self->branch_path()), 'D', $non_interactive,
+  );
+
+  # Check with the user to see if he/she wants to go ahead
+  # ----------------------------------------------------------------------------
+  if (!$non_interactive) {
+    my $mesg = '';
+    if ($self->branch_owner() && !$self->layout()->is_owned_by_user()) {
+      $mesg .= "\n";
+
+      if (exists $FCM1::CmUrl::owner_keywords{$self->branch_owner()}) {
+        my $type = $FCM1::CmUrl::owner_keywords{$self->branch_owner()};
+        $mesg .= '*** WARNING: YOU ARE DELETING A ' . uc ($type) .
+                 ' BRANCH.';
+
+      } else {
+        $mesg .= '*** WARNING: YOU ARE DELETING A BRANCH NOT OWNED BY YOU.';
+      }
+
+      $mesg .= "\n" .
+               '*** Please ensure that you have the owner\'s permission.' .
+               "\n\n";
+    }
+
+    $mesg   .= 'Would you like to go ahead and delete this branch?';
+
+    my $reply = FCM1::Interactive::get_input (
+      title   => 'fcm branch',
+      message => $mesg,
+      type    => 'yn',
+      default => 'n',
+    );
+
+    return unless $reply eq 'y';
+  }
+
+  # Delete branch if answer is "y" for "yes"
+  # ----------------------------------------------------------------------------
+  print 'Deleting branch ', $self->url, ' ...', "\n";
+  $SVN->call(
+    'delete',
+    '-F', $temp_handle->filename(),
+    (defined $password    ? ('--password', $password) : ()),
+    ($svn_non_interactive ? '--non-interactive'       : ()),
+    $self->url(),
+  );
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->display_info (
+#     [SHOW_CHILDREN => 1],
+#     [SHOW_OTHER    => 1]
+#     [SHOW_SIBLINGS => 1]
+#   );
+#
+# DESCRIPTION
+#   This method displays information of the current branch. If SHOW_CHILDREN is
+#   set, it shows information of all current children branches of the current
+#   branch. If SHOW_SIBLINGS is set, it shows information of siblings that have
+#   been merged recently with the current branch. If SHOW_OTHER is set, it shows
+#   information of custom/reverse merges.
+# ------------------------------------------------------------------------------
+
+sub display_info {
+  my $self = shift;
+  my %args = @_;
+
+  # Arguments
+  # ----------------------------------------------------------------------------
+  my $show_children = exists $args{SHOW_CHILDREN} ? $args{SHOW_CHILDREN} : 0;
+  my $show_other    = exists $args{SHOW_OTHER   } ? $args{SHOW_OTHER}    : 0;
+  my $show_siblings = exists $args{SHOW_SIBLINGS} ? $args{SHOW_SIBLINGS} : 0;
+
+  # Useful variables
+  # ----------------------------------------------------------------------------
+  my $separator  = '-' x 80 . "\n";
+  my $separator2 = '  ' . '-' x 78 . "\n";
+
+  # Print "info" as returned by "svn info"
+  # ----------------------------------------------------------------------------
+  for (
+    ['URL',                 'url'            ],
+    ['Repository Root',     'repository:root'],
+    ['Revision',            'revision'       ],
+    ['Last Changed Author', 'commit:author'  ],
+    ['Last Changed Rev',    'commit:revision'],
+    ['Last Changed Date',   'commit:date'    ],
+  ) {
+    my ($key, $flag) = @{$_};
+    if ($self->svninfo(FLAG => $flag)) {
+      printf("%s: %s\n", $key, $self->svninfo(FLAG => $flag));
+    }
+  }
+
+  if ($self->config->verbose) {
+    # Verbose mode, print log message at last changed revision
+    my %log = $self->svnlog (REV => $self->svninfo(FLAG => 'commit:revision'));
+    my @log = split /\n/, $log{msg};
+    print 'Last Changed Log:', "\n\n", map ({'  ' . $_ . "\n"} @log), "\n";
+  }
+
+  if ($self->is_branch) {
+    # Print create information
+    # --------------------------------------------------------------------------
+    my %log = $self->svnlog (REV => $self->create_rev);
+
+    print $separator;
+    print 'Branch Create Author: ', $log{author}, "\n" if $log{author};
+    print 'Branch Create Rev: ', $self->create_rev, "\n";
+    print 'Branch Create Date: ', &svn_date ($log{date}), "\n";
+
+    if ($self->config->verbose) {
+      # Verbose mode, print log message at last create revision
+      my @log = split /\n/, $log{msg};
+      print 'Branch Create Log:', "\n\n", map ({'  ' . $_ . "\n"} @log), "\n";
+    }
+
+    # Print delete information if branch no longer exists
+    # --------------------------------------------------------------------------
+    print 'Branch Delete Rev: ', $self->delete_rev, "\n" if $self->delete_rev;
+
+    # Report merges into/from the parent
+    # --------------------------------------------------------------------------
+    # Print the URL@REV of the parent branch
+    print $separator, 'Branch Parent: ', $self->parent->url_peg, "\n";
+
+    # Set up a new object for the parent at the current revision
+    # --------------------------------------------------------------------------
+    my $p_url  = $self->parent->url;
+    $p_url    .= '@' . $self->pegrev if $self->pegrev;
+    my $parent = FCM1::CmBranch->new (URL => $p_url);
+
+    if (not $parent->url_exists) {
+      print 'Branch parent deleted.', "\n";
+      return;
+    }
+
+    # Report merges into/from the parent
+    # --------------------------------------------------------------------------
+    print $self->_report_merges ($parent, 'Parent');
+  }
+
+  # Report merges with siblings
+  # ----------------------------------------------------------------------------
+  if ($show_siblings) {
+    # Report number of sibling branches found
+    print $separator, 'Searching for siblings ... ';
+    my @siblings = $self->siblings;
+    print scalar (@siblings), ' ', (@siblings> 1 ? 'siblings' : 'sibling'),
+          ' found.', "\n";
+
+    # Report branch name and merge information only if there are recent merges
+    my $out = '';
+    for my $sibling (@siblings) {
+      my $string = $self->_report_merges ($sibling, 'Sibling');
+
+      $out .= $separator2 . '  ' . $sibling->url . "\n" . $string if $string;
+    }
+
+    if (@siblings) {
+      if ($out) {
+        print 'Merges with existing siblings:', "\n", $out;
+
+      } else {
+        print 'No merges with existing siblings.', "\n";
+      }
+    }
+  }
+
+  # Report children
+  # ----------------------------------------------------------------------------
+  if ($show_children) {
+    # Report number of child branches found
+    print $separator, 'Searching for children ... ';
+    my @children = $self->children;
+    print scalar (@children), ' ', (@children > 1 ? 'children' : 'child'),
+          ' found.', "\n";
+
+    # Report children if they exist
+    print 'Current children:', "\n" if @children;
+
+    for my $child (@children) {
+      print $separator2, '  ', $child->url, "\n";
+      print '  Child Create Rev: ', $child->create_rev, "\n";
+      print $self->_report_merges ($child, 'Child');
+    }
+  }
+
+  # Report custom/reverse merges into the branch
+  # ----------------------------------------------------------------------------
+  if ($show_other) {
+    my %log = $self->svnlog (STOP_ON_COPY => 1);
+    my @out;
+
+    # Go down the revision log, checking for merge template messages
+    REV: for my $rev (sort {$b <=> $a} keys %log) {
+      # Loop each line of the log message at each revision
+      my @msg = split /\n/, $log{$rev}{msg};
+
+      for (@msg) {
+        # Ignore unless log message matches a merge template
+        if (/^Reversed r\d+(:\d+)? of \S+$/ or
+            s/^(Custom merge) into \S+(:.+)$/$1$2/) {
+          push @out, ('r' . $rev . ': ' . $_) . "\n";
+        }
+      }
+    }
+
+    print $separator, 'Other merges:', "\n", @out if @out;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_report_merges ($branch, $relation);
+#
+# DESCRIPTION
+#   This method returns a string for displaying merge information with a
+#   branch, the $relation of which can be a Parent, a Sibling or a Child.
+# ------------------------------------------------------------------------------
+
+sub _report_merges {
+  my ($self, $branch, $relation) = @_;
+
+  my $indent    = ($relation eq 'Parent') ? '' : '  ';
+  my $separator = ($relation eq 'Parent') ? ('-' x 80) : ('  ' . '-' x 78);
+  $separator   .= "\n";
+
+  my $return = '';
+
+  # Report last merges into/from the $branch
+  # ----------------------------------------------------------------------------
+  my %merge  = (
+    'Last Merge From ' . $relation . ':'
+    => [$self->last_merge_from ($branch, 1)],
+    'Last Merge Into ' . $relation . ':'
+    => [$branch->last_merge_from ($self, 1)],
+  );
+
+  if ($self->config->verbose) {
+    # Verbose mode, print the log of the merge
+    for my $key (keys %merge) {
+      next if not @{ $merge{$key} };
+
+      # From: target (0) is self, upper delta (1) is $branch
+      # Into: target (0) is $branch, upper delta (1) is self
+      my $t = ($key =~ /From/) ? $self : $branch;
+
+      $return .= $indent . $key . "\n";
+      $return .= $separator . $t->display_svnlog ($merge{$key}[0]->pegrev);
+    }
+
+  } else {
+    # Normal mode, print in simplified form (rREV Parent@REV)
+    for my $key (keys %merge) {
+      next if not @{ $merge{$key} };
+
+      # From: target (0) is self, upper delta (1) is $branch
+      # Into: target (0) is $branch, upper delta (1) is self
+      $return .= $indent . $key . ' r' . $merge{$key}[0]->pegrev . ' ' .
+                 $merge{$key}[1]->path_peg . ' cf. ' .
+                 $merge{$key}[2]->path_peg . "\n";
+    }
+  }
+
+  if ($relation eq 'Sibling') {
+    # For sibling, do not report further if there is no recent merge
+    my @values = values %merge;
+
+    return $return unless (@{ $values[0] } or @{ $values[1] });
+  }
+
+  # Report available merges into/from the $branch
+  # ----------------------------------------------------------------------------
+  my %avail = (
+    'Merges Avail From ' . $relation . ':'
+    => ($self->delete_rev ? [] : [$self->avail_merge_from ($branch, 1)]),
+    'Merges Avail Into ' . $relation . ':'
+    => [$branch->avail_merge_from ($self, 1)],
+  );
+
+  if ($self->config->verbose) {
+    # Verbose mode, print the log of each revision
+    for my $key (sort keys %avail) {
+      next unless @{ $avail{$key} };
+
+      $return .= $indent . $key . "\n";
+
+      my $s = ($key =~ /From/) ? $branch: $self;
+
+      for my $rev (@{ $avail{$key} }) {
+        $return .= $separator . $s->display_svnlog ($rev);
+      }
+    }
+
+  } else {
+    # Normal mode, print only the revisions
+    for my $key (sort keys %avail) {
+      next unless @{ $avail{$key} };
+
+      $return .= $indent . $key . ' ' . join (' ', @{ $avail{$key} }) . "\n";
+    }
+  }
+
+  return $return;
+}
+
+# Returns a File::Temp object containing the commit log for create/del.
+sub _commit_message {
+    my ($self, $message, $action, $non_interactive) = @_;
+    my $commit_message_ctx = $COMMIT_MESSAGE_UTIL->ctx();
+    $commit_message_ctx->set_auto_part($message);
+    $commit_message_ctx->set_info_part(
+        sprintf("%s    %s\n", $action, $self->url())
+    );
+    if (!$non_interactive) {
+        $COMMIT_MESSAGE_UTIL->edit($commit_message_ctx);
+    }
+    $COMMIT_MESSAGE_UTIL->notify($commit_message_ctx);
+    $COMMIT_MESSAGE_UTIL->temp($commit_message_ctx);
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/CmUrl.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/CmUrl.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/CmUrl.pm	(revision 5095)
@@ -0,0 +1,645 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::CmUrl
+#
+# DESCRIPTION
+#   This class contains methods for manipulating a Subversion URL in a standard
+#   FCM project.
+#
+# ------------------------------------------------------------------------------
+
+package FCM1::CmUrl;
+use base qw{FCM1::Base};
+
+use strict;
+use warnings;
+
+use FCM::System::Exception;
+use FCM1::Keyword;
+use FCM1::Util qw/svn_date/;
+
+# Special branches
+our %owner_keywords = (Share => 'shared', Config => 'config', Rel => 'release');
+
+# Revision pattern
+my $rev_pattern = '\d+|HEAD|BASE|COMMITTED|PREV|\{.+\}';
+
+my $E = 'FCM::System::Exception';
+
+# "svn log --xml" handlers.
+# -> element node start tag handlers
+my %SVN_LOG_ELEMENT_0_HANDLER_FOR = (
+#   tag        => handler
+    'logentry' => \&_svn_log_handle_element_0_logentry,
+    'path'     => \&_svn_log_handle_element_0_path,
+);
+# -> text node (after a start tag) handlers
+my %SVN_LOG_TEXT_HANDLER_FOR = (
+#   tag    => handler
+    'date' => \&_svn_log_handle_text_date,
+    'path' => \&_svn_log_handle_text_path,
+);
+
+# Set the SVN utility provided by FCM::System::CM.
+our $SVN;
+sub set_svn_util {
+    $SVN = shift();
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_url = FCM1::CmUrl->new ([URL => $url,]);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::CmUrl class.
+#
+# ARGUMENTS
+#   URL - URL of a branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = FCM1::Base->new (%args);
+
+  $self->{URL} = (exists $args{URL} ? $args{URL} : '');
+
+  for (qw/LAYOUT BRANCH_LIST INFO LIST LOG LOG_RANGE RLIST/) {
+    $self->{$_} = undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->url_peg;
+#   $cm_url->url_peg ($url);
+#
+# DESCRIPTION
+#   This method returns/sets the current URL@PEG.
+# ------------------------------------------------------------------------------
+
+sub url_peg {
+  my $self = shift;
+
+  if (@_) {
+    if (! $self->{URL} or $_[0] ne $self->{URL}) {
+      # Re-set URL
+      $self->{URL} = shift;
+
+      # Re-set essential variables
+      $self->{$_}  = undef for (qw/LAYOUT RLIST LIST INFO LOG LOG_RANGE/);
+    }
+  }
+
+  return $self->{URL};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_url ();
+#
+# DESCRIPTION
+#   Returns true if current url is a valid Subversion URL.
+# ------------------------------------------------------------------------------
+
+sub is_url {
+  my $self = shift;
+
+  # This should handle URL beginning with svn://, http:// and svn+ssh://
+  return ($self->url_peg =~ qr{^[\w\+\-]+://}msx);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->url_exists ([$rev]);
+#
+# DESCRIPTION
+#   Returns true if current url exists (at operative revision $rev) in a
+#   Subversion repository.
+# ------------------------------------------------------------------------------
+
+sub url_exists {
+  my ($self, $rev) = @_;
+
+  my $url = eval {$self->svninfo(FLAG => 'url', REV => $rev)};
+  if ($@) {
+    $@ = undef;
+  }
+
+  defined($url);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $cm_url->svninfo([FLAG => $flag], [REV => $rev]);
+#
+# DESCRIPTION
+#   Returns the value of $flag, where $flag is a field returned by "svn info
+#   --xml". The original hierarchy below the entry element is delimited by a
+#   colon in the name. (If $flag is not set, default to "url".) If REV is
+#   specified, it will be used as the operative revision.
+# ------------------------------------------------------------------------------
+
+sub svninfo {
+  my ($self, %args) = @_;
+  if (!$self->is_url()) {
+    return;
+  }
+  my $flag = exists($args{FLAG}) ? $args{FLAG} : 'url';
+  my $rev  = exists($args{REV})  ? $args{REV}  : undef;
+  $rev ||= ($self->pegrev ? $self->pegrev : 'HEAD');
+  # Get "info" for the specified revision if necessary
+  if (!exists($self->{INFO}{$rev})) {
+    $self->{INFO}{$rev}
+      = $SVN->get_info({'revision' => $rev}, $self->url_peg())->[0];
+  }
+  exists($self->{INFO}{$rev}{$flag}) ? $self->{INFO}{$rev}{$flag} : undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %logs = $cm_url->svnlog (
+#     [REV          => $rev,]
+#     [REV          => \@revs,] # reference to a 2-element array
+#     [STOP_ON_COPY => 1,]
+#   );
+#
+# DESCRIPTION
+#   Returns the logs for the current URL. If REV is a range of revisions or not
+#   specified, return a hash where the keys are revision numbers and the values
+#   are the entries (which are hash references). If a single REV is specified,
+#   return the entry (a hash reference) at the specified REV. Each entry in the
+#   returned list is a hash reference, with the following structure:
+#
+#   $entry = {
+#     author => $author,              # the commit author
+#     date   => $date,                # the commit date (in seconds since epoch)
+#     msg    => $msg,                 # the log message
+#     paths  => {                     # list of changed paths
+#       $path1  => {                  # a changed path
+#         copyfrom-path => $frompath, # copy-from-path
+#         copyfrom-rev  => $fromrev,  # copy-from-revision
+#         action        => $action,   # action status code
+#       },
+#       ...     => { ... },           # ... more changed paths ...
+#     },
+#   }
+# ------------------------------------------------------------------------------
+
+sub svnlog {
+  my $self = shift;
+  my %args = @_;
+
+  my $stop_on_copy  = exists $args{STOP_ON_COPY} ? $args{STOP_ON_COPY} : undef;
+  my $rev_arg       = exists $args{REV}          ? $args{REV}          : 0;
+
+  my @revs;
+
+  # Get revision options
+  # ----------------------------------------------------------------------------
+  if ($rev_arg) {
+    if (ref ($rev_arg)) {
+      # Revision option is an array, a range of revisions specified?
+      ($revs [0], $revs [1]) = @$rev_arg;
+
+    } else {
+      # A single revision specified
+      $revs [0] = $rev_arg;
+    }
+
+    # Expand 'HEAD' revision
+    for my $rev (@revs) {
+      next unless uc ($rev) eq 'HEAD';
+      $rev = $self->svninfo(FLAG => 'revision', REV => 'HEAD');
+    }
+
+  } else {
+    # No revision option specified, get log for all revisions
+    $revs [0] = $self->svninfo(FLAG => 'revision');
+    $revs [1] = 1;
+  }
+
+  $revs [1] = $revs [0] if not $revs [1];
+  @revs     = sort {$b <=> $a} @revs;
+
+  # Check whether a "svn log" run is necessary
+  # ----------------------------------------------------------------------------
+  my $need_update = !($revs[0] == $revs[1] && exists($self->{LOG}{$revs [0]}));
+  my @ranges = @revs;
+  if ($need_update && $self->{LOG_RANGE}) {
+    my %log_range = %{$self->{LOG_RANGE}};
+    $log_range{LOWER_SOC} ||= 0;
+    $log_range{LOWER} ||= 0;
+
+    if ($stop_on_copy && $ranges[1] >= $log_range{LOWER_SOC}) {
+      if ($ranges[1] >= $log_range{LOWER_SOC}) {
+        $ranges[1] = $log_range{UPPER};
+      }
+    }
+    else {
+      if ($ranges[1] >= $log_range{LOWER}) {
+        $ranges[1] = $log_range{UPPER};
+      }
+    }
+  }
+
+  $need_update = 0 if $ranges[0] < $ranges[1];
+
+  if ($need_update) {
+    my @entries = @{$SVN->get_log(
+      {'revision' => join(':', @ranges), 'stop-on-copy' => $stop_on_copy},
+      $self->url_peg(),
+    )};
+    for my $entry (@entries) {
+      $self->{LOG}{$entry->{revision}} = $entry;
+      $entry->{paths} = {map {($_->{path} => $_)} @{$entry->{paths}}};
+    }
+
+    # Update the range cache
+    # --------------------------------------------------------------------------
+    # Upper end of the range
+    $self->{LOG_RANGE}{UPPER} = $ranges [0]
+      if ! $self->{LOG_RANGE}{UPPER} or $ranges [0] > $self->{LOG_RANGE}{UPPER};
+
+    # Lower end of the range, need to take into account the stop-on-copy option
+    if ($stop_on_copy) {
+      # Lower end of the range with stop-on-copy option
+      $self->{LOG_RANGE}{LOWER_SOC} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER_SOC} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER_SOC};
+
+      my $low = (sort {$a <=> $b} keys %{ $self->{LOG} }) [0];
+      $self->{LOG_RANGE}{LOWER} = $low
+        if ! $self->{LOG_RANGE}{LOWER} or $low < $self->{LOG_RANGE}{LOWER};
+
+    } else {
+      # Lower end of the range without the stop-on-copy option
+      $self->{LOG_RANGE}{LOWER} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER};
+
+      $self->{LOG_RANGE}{LOWER_SOC} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER_SOC} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER_SOC};
+    }
+  }
+
+  my %return = ();
+
+  if (! $rev_arg or ref ($rev_arg)) {
+    # REV is an array, return log entries if they are within range
+    for my $rev (sort {$b <=> $a} keys %{ $self->{LOG} }) {
+      next if $rev > $revs [0] or $revs [1] > $rev;
+
+      $return{$rev} = $self->{LOG}{$rev};
+
+      if ($stop_on_copy) {
+        last if exists $self->{LOG}{$rev}{paths}{$self->branch_path} and
+           $self->{LOG}{$rev}{paths}{$self->branch_path}{action} eq 'A';
+      }
+    }
+
+  } else {
+    # REV is a scalar, return log of the specified revision if it exists
+    %return = %{ $self->{LOG}{$revs [0]} } if exists $self->{LOG}{$revs [0]};
+  }
+
+  return %return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $cm_branch->display_svnlog ($rev, [$wiki]);
+#
+# DESCRIPTION
+#   This method returns a string for displaying the log of the current branch
+#   at a $rev. If $wiki is set, returns a string for displaying in a Trac wiki
+#   table.  The value of $wiki should be the Subversion URL of a FCM project
+#   associated with the intended Trac system.
+# ------------------------------------------------------------------------------
+
+sub display_svnlog {
+  my ($self, $rev, $wiki) = @_;
+  my $return = '';
+
+  my %log = $self->svnlog (REV => $rev);
+
+  if ($wiki) {
+    # Output in Trac wiki format
+    # --------------------------------------------------------------------------
+    $return .= '|| ' . &svn_date ($log{date}) . ' || ' . $log{author} . ' || ';
+
+    my $trac_url = FCM1::Keyword::get_browser_url($self->url);
+
+    # Get list of tickets from log
+    my @tickets;
+    while ($log{msg} =~ /(?:(\w+):)?(?:#|ticket:)(\d+)/g) {
+      push @tickets, [$1, $2];
+    }
+    @tickets = sort {
+      if ($a->[0] and $b->[0]) {
+        $a->[0] cmp $b->[0] or $a->[1] <=> $b->[1];
+
+      } elsif ($a->[0]) {
+        1;
+
+      } else {
+        $a->[1] <=> $b->[1];
+      }
+    } @tickets;
+
+    if ($trac_url =~ qr{^$wiki(?:/*|$)}msx) {
+      # URL is in the specified $wiki, use Trac link
+      $return .= '[' . $rev . '] ||';
+
+      for my $ticket (@tickets) {
+        $return .= ' ';
+        $return .= $ticket->[0] . ':' if $ticket->[0];
+        $return .= '#' . $ticket->[1];
+      }
+
+      $return .= ' ||';
+
+    } else {
+      # URL is not in the specified $wiki, use full URL
+      my $rev_url = $trac_url;
+      $rev_url    =~ s{/intertrac/source:.*\z}{/intertrac/changeset:$rev}xms;
+      $return    .= '[' . $rev_url . ' ' . $rev . '] ||';
+
+      my $ticket_url = $trac_url;
+      $ticket_url    =~ s{/intertrac/source:.*\z}{/intertrac/}xms;
+
+      for my $ticket (@tickets) {
+        $return .= ' [' . $ticket_url;
+        $return .= $ticket->[0] . ':' if $ticket->[0];
+        $return .= 'ticket:' . $ticket->[1] . ' ' . $ticket->[1] . ']';
+      }
+
+      $return .= ' ||';
+    }
+
+  } else {
+    # Output in plain text format
+    # --------------------------------------------------------------------------
+    my @msg  = split /\n/, $log{msg};
+    my $line = (@msg > 1 ? ' lines' : ' line');
+
+    $return .= join (
+      ' | ',
+      ('r' . $rev, $log{author}, &svn_date ($log{date}), scalar (@msg) . $line),
+    );
+    $return .= "\n\n";
+    $return .= $log{msg};
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @list = $cm_url->branch_list ($rev);
+#
+# DESCRIPTION
+#   The method returns a list of branches in the current project, assuming the
+#   FCM naming convention. If $rev if specified, it returns the list of
+#   branches at $rev.
+# ------------------------------------------------------------------------------
+
+sub branch_list {
+  my ($self, $rev) = @_;
+  if (!defined($self->project())) {
+    return;
+  }
+  $rev = $self->svninfo(FLAG => 'revision', REV => $rev);
+  if (!exists($self->{BRANCH_LIST}{$rev})) {
+    my %layout_config = %{$self->layout()->get_config()};
+    my $url0 = $self->project_url();
+    my @d1_filters = ();
+    if ($layout_config{'dir-branch'}) {
+      $url0 .= '/' . $layout_config{'dir-branch'};
+    }
+    else {
+      for my $key (qw{trunk tag}) {
+        if ($layout_config{"dir-$key"}) {
+          push(@d1_filters, $layout_config{"dir-$key"});
+        }
+      }
+    }
+    $self->{BRANCH_LIST}{$rev} = [$SVN->get_list(
+      $url0 . '@' . $self->pegrev(),
+      sub {
+        my ($this_url, $this_name, $is_dir, $depth) = @_;
+        if ($depth == 1 && @d1_filters && grep {$this_name eq $_} @d1_filters) {
+          return (0, 0);
+        }
+        my $can_return = $depth >= $layout_config{'depth-branch'};
+        ($can_return, ($is_dir && !$can_return));
+      },
+    )];
+  }
+  @{$self->{BRANCH_LIST}{$rev}};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $layout = $self->layout();
+#
+# DESCRIPTION
+#   Wrap FCM::System::CM::SVN->get_layout($url).
+# ------------------------------------------------------------------------------
+
+sub layout {
+  my ($self) = @_;
+  if (defined($self->{LAYOUT})) {
+    return $self->{LAYOUT};
+  }
+  my $url = $self->url_peg();
+  my $layout = $SVN->get_layout($url);
+  $self->{URL} = $layout->get_url();
+  $self->{LAYOUT} = $layout;
+
+  $layout;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->url();
+#   $url = $cm_url->pegrev();
+#   $url = $cm_url->root();
+#   $url = $cm_url->path();
+#   $url = $cm_url->path_peg();
+#
+# DESCRIPTION
+#   Return the relevant part of the current URL. The url method returns the URL
+#   without the peg revision. The pegrev method returns the peg revision. The
+#   root method returns the repository root. The path method returns the path in
+#   URL under root. The path_peg method returns the path in URL with a peg
+#   revision.
+# ------------------------------------------------------------------------------
+
+sub url {
+  my $layout = $_[0]->layout();
+  $layout->get_root() . $layout->get_path();
+}
+
+sub pegrev {
+  $_[0]->layout()->get_peg_rev();
+}
+
+sub root {
+  $_[0]->layout()->get_root();
+}
+
+sub path {
+  $_[0]->layout()->get_path();
+}
+
+sub path_peg {
+  my $layout = $_[0]->layout();
+  $layout->get_path() . '@' . $layout->get_peg_rev();
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->project_url_peg();
+#   $url = $cm_url->project_url();
+#   $url = $cm_url->project_path();
+#   $url = $cm_url->project();
+#   $url = $cm_url->branch_url();
+#   $url = $cm_url->branch_url_peg();
+#   $url = $cm_url->branch_path();
+#   $url = $cm_url->branch();
+#   $url = $cm_url->subdir();
+#
+# DESCRIPTION
+#   Return the relevant part of the current URL. The "project_*" methods return
+#   the "project" part. The "branch_*" methods return the "branch" part.
+#   The "*_url_peg" methods return the URL@PEG, and the "*_url" methods return
+#   the URL without the peg revision. The "*_path" methods return the path in
+#   the URL under the root.
+# ------------------------------------------------------------------------------
+
+sub project_url_peg {
+  my $layout = $_[0]->layout();
+  if (!defined($layout->get_project())) {
+    return;
+  }
+  my $path = $layout->get_project() ? '/' . $layout->get_project() : q{};
+  $layout->get_root() . $path . '@' . $layout->get_peg_rev();
+}
+
+sub project_url {
+  my $layout = $_[0]->layout();
+  if (!defined($layout->get_project())) {
+    return;
+  }
+  my $path = $layout->get_project() ? '/' . $layout->get_project() : q{};
+  $layout->get_root() . $path;
+}
+
+sub project_path {
+  my $layout = $_[0]->layout();
+  if (!defined($layout->get_project())) {
+    return;
+  }
+  '/' . $layout->get_project();
+}
+
+sub project {
+  $_[0]->layout()->get_project();
+}
+
+sub branch_url_peg {
+  my $layout = $_[0]->layout();
+  if (!$layout->get_branch()) {
+    return;
+  }
+  $_[0]->project_url() . '/' . $layout->get_branch()
+    . '@' . $layout->get_peg_rev();
+}
+
+sub branch_url {
+  my $layout = $_[0]->layout();
+  if (!$layout->get_branch()) {
+    return;
+  }
+  $_[0]->project_url() . '/' . $layout->get_branch();
+}
+
+sub branch_path {
+  my $layout = $_[0]->layout();
+  if (!$layout->get_branch()) {
+    return;
+  }
+  ($_[0]->project() ? '/' . $_[0]->project() : q{}) . '/' . $layout->get_branch();
+}
+
+sub branch {
+  $_[0]->layout()->get_branch();
+}
+
+sub subdir {
+  $_[0]->layout()->get_sub_tree();
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->branch_owner();
+#
+# DESCRIPTION
+#   This method returns the owner of the branch (based on the default layout).
+# ------------------------------------------------------------------------------
+
+sub branch_owner {
+  $_[0]->layout()->get_branch_owner();
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_trunk();
+#   $flag = $cm_url->is_branch();
+#   $flag = $cm_url->is_tag();
+#
+# DESCRIPTION
+#   Return true if the branch of current URL belongs to a given category (i.e.
+#   trunk, branch or tag).
+# ------------------------------------------------------------------------------
+
+sub is_trunk {
+  $_[0]->layout()->is_trunk();
+}
+
+sub is_branch {
+  $_[0]->layout()->is_branch();
+}
+
+sub is_tag {
+  $_[0]->layout()->is_tag();
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Config.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Config.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Config.pm	(revision 5095)
@@ -0,0 +1,898 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::Config
+#
+# DESCRIPTION
+#   This is a class for reading and processing central and user configuration
+#   settings for FCM.
+#
+# ------------------------------------------------------------------------------
+
+package FCM1::Config;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use File::Basename;
+use File::Spec::Functions;
+use FindBin;
+use POSIX qw/setlocale LC_ALL/;
+
+# FCM component modules
+use FCM1::CfgFile;
+
+# Other declarations:
+sub _get_hash_value;
+
+# Delimiter for setting and for list
+our $DELIMITER         = '::';
+our $DELIMITER_PATTERN = qr{::|/};
+our $DELIMITER_LIST    = ',';
+
+my $INSTANCE;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = FCM1::Config->instance();
+#
+# DESCRIPTION
+#   Returns an instance of this class.
+# ------------------------------------------------------------------------------
+
+sub instance {
+    my ($class) = @_;
+    if (!defined($INSTANCE)) {
+        $INSTANCE = $class->new();
+        $INSTANCE->get_config();
+        $INSTANCE->is_initialising(0);
+    }
+    return $INSTANCE;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::Config->new (VERBOSE => $verbose);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::Config class.
+#
+# ARGUMENTS
+#   VERBOSE - Set the verbose level of diagnostic output
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  # Ensure that all subsequent Subversion output is in UK English
+  if (setlocale (LC_ALL, 'en_GB')) {
+    $ENV{LANG} = 'en_GB';
+  }
+
+  my $self = {
+    initialising   => 1,
+    central_config => undef,
+    user_config    => undef,
+    user_id        => undef,
+    verbose        => exists $args{VERBOSE} ? $args{VERBOSE} : undef,
+    variable       => {},
+
+    # Primary settings
+    setting => {
+      # Fortran BLOCKDATA dependencies
+      BLD_BLOCKDATA => {},
+
+      # Copy dummy target
+      BLD_CPDUMMY => '$(FCM_DONEDIR)/FCM_CP.dummy',
+
+      # No dependency check
+      BLD_DEP_N => {},
+
+      # Additional (PP) dependencies
+      BLD_DEP => {},
+      BLD_DEP_PP => {},
+
+      # Excluded dependency
+      BLD_DEP_EXCL => {
+        '' => [
+          # Fortran intrinsic modules
+          'USE' . $DELIMITER . 'ISO_C_BINDING',
+          'USE' . $DELIMITER . 'IEEE_EXCEPTIONS',
+          'USE' . $DELIMITER . 'IEEE_ARITHMETIC',
+          'USE' . $DELIMITER . 'IEEE_FEATURES',
+
+          # Fortran intrinsic subroutines
+          'OBJ' . $DELIMITER . 'CPU_TIME',
+          'OBJ' . $DELIMITER . 'GET_COMMAND',
+          'OBJ' . $DELIMITER . 'GET_COMMAND_ARGUMENT',
+          'OBJ' . $DELIMITER . 'GET_ENVIRONMENT_VARIABLE',
+          'OBJ' . $DELIMITER . 'MOVE_ALLOC',
+          'OBJ' . $DELIMITER . 'MVBITS',
+          'OBJ' . $DELIMITER . 'RANDOM_NUMBER',
+          'OBJ' . $DELIMITER . 'RANDOM_SEED',
+          'OBJ' . $DELIMITER . 'SYSTEM_CLOCK',
+
+          # Dummy statements
+          'OBJ' . $DELIMITER . 'NONE',
+          'EXE' . $DELIMITER . 'NONE',
+        ],
+      },
+
+      # Extra executable dependencies
+      BLD_DEP_EXE => {},
+
+      # Dependency pattern for each type
+      BLD_DEP_PATTERN => {
+        H         => q/^#\s*include\s*['"](\S+)['"]/,
+        USE       => q/^\s*use\s+(\w+)/,
+        INTERFACE => q/^#?\s*include\s+['"](\S+##OUTFILE_EXT/ . $DELIMITER .
+                     q/INTERFACE##)['"]/,
+        INC       => q/^\s*include\s+['"](\S+)['"]/,
+        OBJ       => q#^\s*(?:/\*|!)\s*depends\s*on\s*:\s*(\S+)#,
+        EXE       => q/^\s*(?:#|;)\s*(?:calls|list|if|interface)\s*:\s*(\S+)/,
+      },
+
+      # Rename main program targets
+      BLD_EXE_NAME => {},
+
+      # Rename library targets
+      BLD_LIB => {'' => 'fcm_default'},
+
+      # Name of Makefile and run environment shell script
+      BLD_MISC => {
+        'BLDMAKEFILE' => 'Makefile',
+        'BLDRUNENVSH' => 'fcm_env.sh',
+      },
+
+      # PP flags
+      BLD_PP => {},
+
+      # Custom source file type
+      BLD_TYPE => {},
+
+      # Types that always need to be built
+      BLD_TYPE_ALWAYS_BUILD =>                   'PVWAVE' .
+                               $DELIMITER_LIST . 'GENLIST' .
+                               $DELIMITER_LIST . 'SQL',
+
+      # Dependency scan types
+      BLD_TYPE_DEP => {
+        FORTRAN =>              'USE' .
+                   $DELIMITER . 'INTERFACE' .
+                   $DELIMITER . 'INC' .
+                   $DELIMITER . 'OBJ',
+        FPP     =>              'USE' .
+                   $DELIMITER . 'INTERFACE' .
+                   $DELIMITER . 'INC' .
+                   $DELIMITER . 'H' .
+                   $DELIMITER . 'OBJ',
+        CPP     =>              'H' .
+                   $DELIMITER . 'OBJ',
+        C       =>              'H' .
+                   $DELIMITER . 'OBJ',
+        SCRIPT  =>              'EXE',
+      },
+
+      # Dependency scan types for pre-processing
+      BLD_TYPE_DEP_PP => {
+        FPP => 'H',
+        CPP => 'H',
+        C   => 'H',
+      },
+
+      # Types that cannot have duplicated targets
+      BLD_TYPE_NO_DUPLICATED_TARGET => '',
+
+      # BLD_VPATH, each value must be a comma separate list
+      # ''     translates to %
+      # 'FLAG' translates to {OUTFILE_EXT}{FLAG}
+      BLD_VPATH   => {
+        BIN   => q{},
+        ETC   => 'ETC',
+        DONE  => join($DELIMITER_LIST, qw{DONE IDONE}),
+        FLAGS => 'FLAGS',
+        INC   => q{},
+        LIB   => 'LIB',
+        OBJ   => 'OBJ',
+      },
+
+      # Cache basename
+      CACHE          => '.config',
+      CACHE_DEP      => '.config_dep',
+      CACHE_DEP_PP   => '.config_dep_pp',
+      CACHE_FILE_SRC => '.config_file_src',
+
+      # Types of "inc" statements expandable CFG files
+      CFG_EXP_INC =>                   'BLD' .
+                     $DELIMITER_LIST . 'EXT' .
+                     $DELIMITER_LIST . 'FCM',
+
+      # Configuration file labels that can be declared more than once
+      CFG_KEYWORD =>                   'USE' .
+                     $DELIMITER_LIST . 'INC' .
+                     $DELIMITER_LIST . 'TARGET' .
+                     $DELIMITER_LIST . 'BLD_DEP_EXCL',
+
+      # Labels for all types of FCM configuration files
+      CFG_LABEL => {
+        CFGFILE => 'CFG', # config file information
+        INC     => 'INC', # "include" from an configuration file
+
+        # Labels for central/user internal config setting
+        SETTING => 'SET',
+
+        # Labels for systems that allow inheritance
+        DEST => 'DEST', # destination
+        USE  => 'USE',  # use (inherit) a previous configuration
+
+        # Labels for bld and pck cfg
+        TARGET => 'TARGET', # BLD: declare targets, PCK: target of source file
+
+        # Labels for bld cfg
+        BLD_BLOCKDATA => 'BLOCKDATA',   # declare Fortran BLOCKDATA dependencies
+        BLD_DEP       => 'DEP',         # additional dependencies
+        BLD_DEP_N     => 'NO_DEP',      # no dependency check
+        BLD_DEP_EXCL  => 'EXCL_DEP',    # exclude automatic dependencies
+        BLD_DEP_EXE   => 'EXE_DEP',     # declare dependencies for program
+        BLD_EXE_NAME  => 'EXE_NAME',    # rename a main program
+        BLD_LIB       => 'LIB',         # rename library
+        BLD_PP        => 'PP',          # sub-package needs pre-process?
+        BLD_TYPE      => 'SRC_TYPE',    # custom source file type
+        DIR           => 'DIR',         # DEPRECATED, same as DEST
+        INFILE_EXT    => 'INFILE_EXT',  # change input file name extension type
+        INHERIT       => 'INHERIT',     # inheritance flag
+        NAME          => 'NAME',        # name the build
+        OUTFILE_EXT   => 'OUTFILE_EXT', # change output file type extension
+        FILE          => 'SRC',         # declare a sub-package
+        SEARCH_SRC    => 'SEARCH_SRC',  # search src/ sub-directory?
+        TOOL          => 'TOOL',        # declare a tool
+
+        # Labels for ext cfg
+        BDECLARE   => 'BLD',      # build declaration
+        CONFLICT   => 'CONFLICT', # set conflict mode
+        DIRS       => 'SRC',      # declare source directory
+        EXPDIRS    => 'EXPSRC',   # declare expandable source directory
+        MIRROR     => 'MIRROR',   # DEPRECATED, same as RDEST::MIRROR_CMD
+        OVERRIDE   => 'OVERRIDE', # DEPRECATED, replaced by CONFLICT
+        RDEST      => 'RDEST',    # declare remote destionation
+        REVISION   => 'REVISION', # declare branch revision in a project
+        REVMATCH   => 'REVMATCH', # branch revision must match changed revision
+        REPOS      => 'REPOS',    # declare branch in a project
+        VERSION    => 'VERSION',  # DEPRECATED, same as REVISION
+      },
+
+      # Default names of known FCM configuration files
+      CFG_NAME => {
+        BLD        => 'bld.cfg',      # build configuration file
+        EXT        => 'ext.cfg',      # extract configuration file
+        PARSED     => 'parsed_',      # as-parsed configuration file prefix
+      },
+
+      # Latest version of known FCM configuration files
+      CFG_VERSION => {
+        BLD        => '1.0', # bld cfg
+        EXT        => '1.0', # ext cfg
+      },
+
+      # Standard sub-directories for extract/build
+      DIR => {
+        BIN    => 'bin',    # executable
+        BLD    => 'bld',    # build
+        CACHE  => '.cache', # cache
+        CFG    => 'cfg',    # configuration
+        DONE   => 'done',   # "done"
+        ETC    => 'etc',    # miscellaneous items
+        FLAGS  => 'flags',  # "flags"
+        INC    => 'inc',    # include
+        LIB    => 'lib',    # library
+        OBJ    => 'obj',    # object
+        PPSRC  => 'ppsrc',  # pre-processed source
+        SRC    => 'src',    # source
+        TMP    => 'tmp',    # temporary directory
+      },
+
+      # A flag to indicate whether the revision of a given branch for extract
+      # must match with the revision of a changed revision of the branch
+      EXT_REVMATCH => 0, # default is false (allow any revision)
+
+      # Input file name extension and type
+      # (may overlap with output (below) and vpath (above))
+      INFILE_EXT => {
+        # General extensions
+        'f'    =>              'FORTRAN' .
+                  $DELIMITER . 'SOURCE',
+        'for'  =>              'FORTRAN' .
+                  $DELIMITER . 'SOURCE',
+        'ftn'  =>              'FORTRAN' .
+                  $DELIMITER . 'SOURCE',
+        'f77'  =>              'FORTRAN' .
+                  $DELIMITER . 'SOURCE',
+        'f90'  =>              'FORTRAN' .
+                  $DELIMITER . 'FORTRAN9X' .
+                  $DELIMITER . 'SOURCE',
+        'f95'  =>              'FORTRAN' .
+                  $DELIMITER . 'FORTRAN9X' .
+                  $DELIMITER . 'SOURCE',
+        'F'    =>              'FPP' .
+                  $DELIMITER . 'SOURCE',
+        'FOR'  =>              'FPP' .
+                  $DELIMITER . 'SOURCE',
+        'FTN'  =>              'FPP' .
+                  $DELIMITER . 'SOURCE',
+        'F77'  =>              'FPP' .
+                  $DELIMITER . 'SOURCE',
+        'F90'  =>              'FPP' .
+                  $DELIMITER . 'FPP9X' .
+                  $DELIMITER . 'SOURCE',
+        'F95'  =>              'FPP' .
+                  $DELIMITER . 'FPP9X' .
+                  $DELIMITER . 'SOURCE',
+        'c'    =>              'C' .
+                  $DELIMITER . 'SOURCE',
+        'cpp'  =>              'C' .
+                  $DELIMITER . 'C++' .
+                  $DELIMITER . 'SOURCE',
+        'h'    =>              'CPP' .
+                  $DELIMITER . 'INCLUDE',
+        'o'    =>              'BINARY' .
+                  $DELIMITER . 'OBJ',
+        'obj'  =>              'BINARY' .
+                  $DELIMITER . 'OBJ',
+        'exe'  =>              'BINARY' .
+                  $DELIMITER . 'EXE',
+        'a'    =>              'BINARY' .
+                  $DELIMITER . 'LIB',
+        'sh'   =>              'SCRIPT' .
+                  $DELIMITER . 'SHELL',
+        'ksh'  =>              'SCRIPT' .
+                  $DELIMITER . 'SHELL',
+        'bash' =>              'SCRIPT' .
+                  $DELIMITER . 'SHELL',
+        'csh'  =>              'SCRIPT' .
+                  $DELIMITER . 'SHELL',
+        'pl'   =>              'SCRIPT' .
+                  $DELIMITER . 'PERL',
+        'pm'   =>              'SCRIPT' .
+                  $DELIMITER . 'PERL',
+        'py'   =>              'SCRIPT' .
+                  $DELIMITER . 'PYTHON',
+        'tcl'  =>              'SCRIPT' .
+                  $DELIMITER . 'TCL',
+        'pro'  =>              'SCRIPT' .
+                  $DELIMITER . 'PVWAVE',
+
+        # Local extensions
+        'cfg'       =>              'CFGFILE',
+        'h90'       =>              'CPP' .
+                       $DELIMITER . 'INCLUDE',
+        'inc'       =>              'FORTRAN' .
+                       $DELIMITER . 'FORTRAN9X' .
+                       $DELIMITER . 'INCLUDE',
+        'interface' =>              'FORTRAN' .
+                       $DELIMITER . 'FORTRAN9X' .
+                       $DELIMITER . 'INCLUDE' .
+                       $DELIMITER . 'INTERFACE',
+      },
+
+      # Ignore input files matching the following names (comma-separated list)
+      INFILE_IGNORE =>                   'fcm_env.ksh' .
+                       $DELIMITER_LIST . 'fcm_env.sh',
+
+      # Input file name pattern and type
+      INFILE_PAT => {
+        '\w+Scr_\w+'              =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL',
+        '\w+Comp_\w+'             =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL' .
+                                     $DELIMITER . 'GENTASK',
+        '\w+(?:IF|Interface)_\w+' =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL' .
+                                     $DELIMITER . 'GENIF',
+        '\w+Suite_\w+'            =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL' .
+                                     $DELIMITER . 'GENSUITE',
+        '\w+List_\w+'             =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL' .
+                                     $DELIMITER . 'GENLIST',
+        '\w+Sql_\w+'              =>              'SCRIPT' .
+                                     $DELIMITER . 'SQL',
+      },
+
+      # Input text file pattern and type
+      INFILE_TXT => {
+        '(?:[ck]|ba)?sh'  =>              'SCRIPT' .
+                             $DELIMITER . 'SHELL',
+        'perl'            =>              'SCRIPT' .
+                             $DELIMITER . 'PERL',
+        'python'          =>              'SCRIPT' .
+                             $DELIMITER . 'PYTHON',
+        'tcl(?:sh)?|wish' =>              'SCRIPT' .
+                             $DELIMITER . 'TCL',
+      },
+
+      # Lock file
+      LOCK => {
+        BLDLOCK => 'fcm.bld.lock', # build lock file
+        EXTLOCK => 'fcm.ext.lock', # extract lock file
+      },
+
+      # Output file type and extension
+      # (may overlap with input and vpath (above))
+      OUTFILE_EXT => {
+        CFG       => '.cfg',       # FCM configuration file
+        DONE      => '.done',      # "done" files for compiled source
+        ETC       => '.etc',       # "etc" dummy file
+        EXE       => '.exe',       # binary executables
+        FLAGS     => '.flags',     # "flags" files, compiler flags config
+        IDONE     => '.idone',     # "done" files for included source
+        INTERFACE => '.interface', # interface for F90 subroutines/functions
+        LIB       => '.a',         # archive object library
+        MOD       => '.mod',       # compiled Fortran module information files
+        OBJ       => '.o',         # compiled object files
+        PDONE     => '.pdone',     # "done" files for pre-processed files
+        TAR       => '.tar',       # TAR archive
+      },
+
+      # Build commands and options (i.e. tools)
+      TOOL => {
+        SHELL        => '/bin/sh',         # Default shell
+
+        CPP          => 'cpp',             # C pre-processor
+        CPPFLAGS     => '-C',              # CPP flags
+        CPP_INCLUDE  => '-I',              # CPP flag, specify "include" path
+        CPP_DEFINE   => '-D',              # CPP flag, define macro
+        CPPKEYS      => '',                # CPP keys (definition macro)
+
+        CC           => 'cc',              # C compiler
+        CFLAGS       => '',                # CC flags
+        CC_COMPILE   => '-c',              # CC flag, compile only
+        CC_OUTPUT    => '-o',              # CC flag, specify output file name
+        CC_INCLUDE   => '-I',              # CC flag, specify "include" path
+        CC_DEFINE    => '-D',              # CC flag, define macro
+
+        FPP          => 'cpp',             # Fortran pre-processor
+        FPPFLAGS     => '-P -traditional', # FPP flags
+        FPP_INCLUDE  => '-I',              # FPP flag, specify "include" path
+        FPP_DEFINE   => '-D',              # FPP flag, define macro
+        FPPKEYS      => '',                # FPP keys (definition macro)
+
+        FC           => 'f90',             # Fortran compiler
+        FFLAGS       => '',                # FC flags
+        FC_COMPILE   => '-c',              # FC flag, compile only
+        FC_OUTPUT    => '-o',              # FC flag, specify output file name
+        FC_INCLUDE   => '-I',              # FC flag, specify "include" path
+        FC_MODSEARCH => '',                # FC flag, specify "module" path
+        FC_DEFINE    => '-D',              # FC flag, define macro
+
+        LD           => '',                # linker
+        LDFLAGS      => '',                # LD flags
+        LD_OUTPUT    => '-o',              # LD flag, specify output file name
+        LD_LIBSEARCH => '-L',              # LD flag, specify "library" path
+        LD_LIBLINK   => '-l',              # LD flag, specify link library
+
+        AR           => 'ar',              # library archiver
+        ARFLAGS      => 'rs',              # AR flags
+
+        MAKE         => 'make',            # make command
+        MAKEFLAGS    => '',                # make flags
+        MAKE_FILE    => '-f',              # make flag, path to Makefile
+        MAKE_SILENT  => '-s',              # make flag, silent diagnostic
+        MAKE_JOB     => '-j',              # make flag, number of jobs
+
+        INTERFACE    => 'file',            # name interface after file/program
+        GENINTERFACE => '',                # Fortran 9x interface generator
+
+        DIFF3        => 'diff3',           # extract diff3 merge
+        DIFF3FLAGS   => '-E -m',           # DIFF3 flags
+        GRAPHIC_DIFF => 'xxdiff',          # graphical diff tool
+        GRAPHIC_MERGE=> 'xxdiff',          # graphical merge tool
+      },
+
+      # List of tools that are local to FCM, (will not be exported to a Makefile)
+      TOOL_LOCAL =>                   'CPP' .
+                    $DELIMITER_LIST . 'CPPFLAGS' .
+                    $DELIMITER_LIST . 'CPP_INCLUDE' .
+                    $DELIMITER_LIST . 'CPP_DEFINE' .
+                    $DELIMITER_LIST . 'DIFF3' .
+                    $DELIMITER_LIST . 'DIFF3_FLAGS' .
+                    $DELIMITER_LIST . 'FPP' .
+                    $DELIMITER_LIST . 'FPPFLAGS' .
+                    $DELIMITER_LIST . 'FPP_INCLUDE' .
+                    $DELIMITER_LIST . 'FPP_DEFINE' .
+                    $DELIMITER_LIST . 'GRAPHIC_DIFF' .
+                    $DELIMITER_LIST . 'GRAPHIC_MERGE' .
+                    $DELIMITER_LIST . 'MAKE' .
+                    $DELIMITER_LIST . 'MAKEFLAGS' .
+                    $DELIMITER_LIST . 'MAKE_FILE' .
+                    $DELIMITER_LIST . 'MAKE_SILENT' .
+                    $DELIMITER_LIST . 'MAKE_JOB' .
+                    $DELIMITER_LIST . 'INTERFACE' .
+                    $DELIMITER_LIST . 'GENINTERFACE' .
+                    $DELIMITER_LIST . 'MIRROR' .
+                    $DELIMITER_LIST . 'REMOTE_SHELL',
+
+      # List of tools that allow sub-package declarations
+      TOOL_PACKAGE =>                   'CPPFLAGS' .
+                      $DELIMITER_LIST . 'CPPKEYS' .
+                      $DELIMITER_LIST . 'CFLAGS' .
+                      $DELIMITER_LIST . 'FPPFLAGS' .
+                      $DELIMITER_LIST . 'FPPKEYS' .
+                      $DELIMITER_LIST . 'FFLAGS' .
+                      $DELIMITER_LIST . 'LD' .
+                      $DELIMITER_LIST . 'LDFLAGS' .
+                      $DELIMITER_LIST . 'INTERFACE' .
+                      $DELIMITER_LIST . 'GENINTERFACE',
+
+      # Supported tools for compilable source
+      TOOL_SRC_PP => {
+        FPP     => {
+          COMMAND => 'FPP',
+          FLAGS   => 'FPPFLAGS',
+          PPKEYS  => 'FPPKEYS',
+          INCLUDE => 'FPP_INCLUDE',
+          DEFINE  => 'FPP_DEFINE',
+        },
+
+        C       => {
+          COMMAND => 'CPP',
+          FLAGS   => 'CPPFLAGS',
+          PPKEYS  => 'CPPKEYS',
+          INCLUDE => 'CPP_INCLUDE',
+          DEFINE  => 'CPP_DEFINE',
+        },
+      },
+
+      # Supported tools for compilable source
+      TOOL_SRC => {
+        FORTRAN => {
+          COMMAND => 'FC',
+          FLAGS   => 'FFLAGS',
+          OUTPUT  => 'FC_OUTPUT',
+          INCLUDE => 'FC_INCLUDE',
+        },
+
+        FPP     => {
+          COMMAND => 'FC',
+          FLAGS   => 'FFLAGS',
+          PPKEYS  => 'FPPKEYS',
+          OUTPUT  => 'FC_OUTPUT',
+          INCLUDE => 'FC_INCLUDE',
+          DEFINE  => 'FC_DEFINE',
+        },
+
+        C       => {
+          COMMAND => 'CC',
+          FLAGS   => 'CFLAGS',
+          PPKEYS  => 'CPPKEYS',
+          OUTPUT  => 'CC_OUTPUT',
+          INCLUDE => 'CC_INCLUDE',
+          DEFINE  => 'CC_DEFINE',
+        },
+      },
+
+      # FCM URL keyword and prefix, FCM revision keyword, and FCM Trac URL
+      URL          => {},
+      URL_REVISION => {},
+
+      URL_BROWSER_MAPPING => {},
+      URL_BROWSER_MAPPING_DEFAULT => {
+        LOCATION_COMPONENT_PATTERN
+        => qr{\A // ([^/]+) /+ ([^/]+)_svn /+(.*) \z}xms,
+        BROWSER_URL_TEMPLATE
+        => 'http://{1}/projects/{2}/intertrac/source:{3}{4}',
+        BROWSER_REV_TEMPLATE => '@{1}',
+      },
+
+      # Default web browser
+      WEB_BROWSER   => 'firefox',
+    },
+  };
+
+  # Backward compatibility: the REPOS setting is equivalent to the URL setting
+  $self->{setting}{REPOS} = $self->{setting}{URL};
+
+  # Alias the REVISION and TRAC setting to URL_REVISION and URL_TRAC
+  $self->{setting}{REVISION} = $self->{setting}{URL_REVISION};
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in the "new" method.
+# ------------------------------------------------------------------------------
+
+for my $name (qw/central_config user_config user_id verbose/) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'central_config') {
+        # Central configuration file
+        if (-f catfile (dirname ($FindBin::Bin), 'etc', 'fcm.cfg')) {
+          $self->{$name} = catfile (
+            dirname ($FindBin::Bin), 'etc', 'fcm.cfg'
+          );
+
+        } elsif (-f catfile ($FindBin::Bin, 'fcm.cfg')) {
+          $self->{$name} = catfile ($FindBin::Bin, 'fcm.cfg');
+        }
+
+      } elsif ($name eq 'user_config') {
+        # User configuration file
+        my $home = (getpwuid ($<))[7];
+        $home = $ENV{HOME} if not defined $home;
+        $self->{$name} = catfile ($home, '.fcm')
+          if defined ($home) and -f catfile ($home, '.fcm');
+
+      } elsif ($name eq 'user_id') {
+        # User ID of current process
+        my $user = (getpwuid ($<))[0];
+        $user = $ENV{LOGNAME} if not defined $user;
+        $user = $ENV{USER} if not defined $user;
+        $self->{$name} = $user;
+
+      } elsif ($name eq 'verbose') {
+        # Verbose mode
+        $self->{$name} = exists $ENV{FCM_VERBOSE} ? $ENV{FCM_VERBOSE} : 1;
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->is_initialising();
+#
+# DESCRIPTION
+#   Returns true if this object is initialising.
+# ------------------------------------------------------------------------------
+sub is_initialising {
+  my ($self, $value) = @_;
+  if (defined($value)) {
+    $self->{initialising} = $value;
+  }
+  return $self->{initialising};
+}
+
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in the "new" method.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (qw/variable/) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    $self->{$name} = {} if not defined ($self->{$name});
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $setting = $obj->setting (@labels);
+#   $obj->setting (\@labels, $setting);
+#
+# DESCRIPTION
+#   This method returns/sets an item under the setting hash table. The depth
+#   within the hash table is given by the list of arguments @labels, which
+#   should match with the keys in the multi-dimension setting hash table.
+# ------------------------------------------------------------------------------
+
+sub setting {
+  my $self = shift;
+
+  if (@_) {
+    my $arg1 = shift;
+    my $s    = $self->{setting};
+
+    if (ref ($arg1) eq 'ARRAY') {
+      # Assign setting
+      # ------------------------------------------------------------------------
+      my $value = shift;
+
+      while (defined (my $label = shift @$arg1)) {
+        if (exists $s->{$label}) {
+          if (ref $s->{$label} eq 'HASH') {
+            $s = $s->{$label};
+
+          } else {
+            $s->{$label} = $value;
+            last;
+          }
+
+        } else {
+          if (@$arg1) {
+            $s->{$label} = {};
+            $s           = $s->{$label};
+
+          } else {
+            $s->{$label} = $value;
+          }
+        }
+      }
+
+    } else {
+      # Get setting
+      # ------------------------------------------------------------------------
+      return _get_hash_value ($s->{$arg1}, @_) if exists $s->{$arg1};
+    }
+  }
+
+  return undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj->get_config ();
+#
+# DESCRIPTION
+#   This method reads the configuration settings from the central and the user
+#   configuration files.
+# ------------------------------------------------------------------------------
+
+sub get_config {
+  my $self = shift;
+
+  $self->_read_config_file ($self->central_config);  
+  $self->_read_config_file ($self->user_config);
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj->_read_config_file ();
+#
+# DESCRIPTION
+#   This internal method reads a configuration file and assign values to the
+#   attributes of the current instance.
+# ------------------------------------------------------------------------------
+
+sub _read_config_file {
+  my $self        = shift;
+  my $config_file = $_[0];
+
+  if (!$config_file || !-f $config_file) {
+    return;
+  }
+
+  my $cfgfile = FCM1::CfgFile->new (SRC => $config_file, TYPE => 'FCM');
+  $cfgfile->read_cfg ();
+
+  LINE: for my $line (@{ $cfgfile->lines }) {
+    next unless $line->label;
+
+    # "Environment variables" start with $
+    if ($line->label =~ /^\$([A-Za-z_]\w*)$/) {
+      $ENV{$1} = $line->value;
+      next LINE;
+    }
+
+    # "Settings variables" start with "set"
+    if ($line->label_starts_with_cfg ('SETTING')) {
+      my @tags = $line->label_fields;
+      shift @tags;
+      @tags = map {uc} @tags;
+      $self->setting (\@tags, $line->value);
+      next LINE;
+    }
+
+    # Not a standard setting variable, put in internal variable list
+    (my $label = $line->label) =~ s/^\%//;
+    $self->variable ($label, $line->value);
+  }
+
+  1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ref = _get_hash_value (arg1, arg2, ...);
+#
+# DESCRIPTION
+#   This internal method recursively gets a value from a multi-dimensional
+#   hash.
+# ------------------------------------------------------------------------------
+
+sub _get_hash_value {
+  my $value = shift;
+
+  while (defined (my $arg = shift)) {
+    if (exists $value->{$arg}) {
+      $value = $value->{$arg};
+
+    } else {
+      return undef;
+    }
+  }
+
+  return $value;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ConfigSystem.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ConfigSystem.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ConfigSystem.pm	(revision 5095)
@@ -0,0 +1,754 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::ConfigSystem
+#
+# DESCRIPTION
+#   This is the base class for FCM systems that are based on inherited
+#   configuration files, e.g. the extract and the build systems.
+#
+# ------------------------------------------------------------------------------
+
+package FCM1::ConfigSystem;
+use base qw{FCM1::Base};
+
+use strict;
+use warnings;
+
+use FCM1::CfgFile;
+use FCM1::CfgLine;
+use FCM1::Dest;
+use FCM1::Util     qw{expand_tilde e_report w_report};
+use Sys::Hostname qw{hostname};
+
+# List of property methods for this class
+my @scalar_properties = (
+ 'cfg',         # configuration file
+ 'cfg_methods', # list of sub-methods for parse_cfg
+ 'cfg_prefix',  # optional prefix in configuration declaration
+ 'dest',        # destination for output
+ 'inherit',     # list of inherited configurations
+ 'inherited',   # list of inheritance hierarchy
+ 'type',        # system type
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::ConfigSystem->new;
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::ConfigSystem class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = FCM1::Base->new (%args);
+
+  $self->{$_} = undef for (@scalar_properties);
+
+  bless $self, $class;
+
+  # List of sub-methods for parse_cfg
+  $self->cfg_methods ([qw/header inherit dest/]);
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'cfg') {
+        # New configuration file
+        $self->{$name} = FCM1::CfgFile->new (TYPE => $self->type);
+
+      } elsif ($name =~ /^(?:cfg_methods|inherit|inherited)$/) {
+        # Reference to an array
+        $self->{$name} = [];
+
+      } elsif ($name eq 'cfg_prefix' or $name eq 'type') {
+        # Reference to an array
+        $self->{$name} = '';
+
+      } elsif ($name eq 'dest') {
+        # New destination
+        $self->{$name} = FCM1::Dest->new (TYPE => $self->type);
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $out_of_date) = $obj->check_cache ();
+#
+# DESCRIPTION
+#   This method returns $rc = 1 on success or undef on failure. It returns
+#   $out_of_date = 1 if current cache file is out of date relative to those in
+#   inherited runs or 0 otherwise.
+# ------------------------------------------------------------------------------
+
+sub check_cache {
+  my $self = shift;
+
+  my $rc = 1;
+  my $out_of_date = 0;
+
+  if (@{ $self->inherit } and -f $self->dest->cache) {
+    # Get modification time of current cache file
+    my $cur_mtime = (stat ($self->dest->cache))[9];
+
+    # Compare with modification times of inherited cache files
+    for my $use (@{ $self->inherit }) {
+      next unless -f $use->dest->cache;
+      my $use_mtime = (stat ($use->dest->cache))[9];
+      $out_of_date = 1 if $use_mtime > $cur_mtime;
+    }
+  }
+
+  return ($rc, $out_of_date);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->check_lock ();
+#
+# DESCRIPTION
+#   This method returns true if no lock is found in the destination or if the
+#   locks found are allowed. 
+# ------------------------------------------------------------------------------
+
+sub check_lock {
+  my $self = shift;
+
+  # Check all types of locks
+  for my $method (@FCM1::Dest::lockfiles) {
+    my $lock = $self->dest->$method;
+
+    # Check whether lock exists
+    next unless -e $lock;
+
+    # Check whether this lock is allowed
+    next if $self->check_lock_is_allowed ($lock);
+
+    # Throw error if a lock exists
+    w_report 'ERROR: ', $lock, ': lock file exists,';
+    w_report '       ', $self->dest->rootdir, ': destination is busy.';
+    return;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->check_lock_is_allowed ($lock);
+#
+# DESCRIPTION
+#   This method returns true if it is OK for $lock to exist in the destination.
+# ------------------------------------------------------------------------------
+
+sub check_lock_is_allowed {
+  my ($self, $lock) = @_;
+
+  # Disallow all types of locks by default
+  return 0;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->compare_setting (
+#     METHOD_LIST  => \@method_list,
+#     [METHOD_ARGS => \@method_args,]
+#     [CACHEBASE   => $cachebase,]
+#   );
+#
+# DESCRIPTION
+#   This method gets settings from the previous cache and updates the current.
+#
+# METHOD
+#   The method returns true on success. @method_list must be a list of method
+#   names for processing the cached lines in the previous run. If an existing
+#   cache exists, its content is read into $old_lines, which is a list of
+#   FCM1::CfgLine objects. Otherwise, $old_lines is set to undef. If $cachebase
+#   is set, it is used for as the cache basename. Otherwise, the default for
+#   the current system is used. It calls each method in the @method_list using
+#   $self->$method ($old_lines, @method_args), which should return a
+#   two-element list. The first element should be a return code (1 for out of
+#   date, 0 for up to date and undef for failure). The second element should be
+#   a reference to a list of FCM1::CfgLine objects for the output.
+# ------------------------------------------------------------------------------
+
+sub compare_setting {
+  my ($self, %args) = @_;
+
+  my @method_list = exists ($args{METHOD_LIST}) ? @{ $args{METHOD_LIST} } : ();
+  my @method_args = exists ($args{METHOD_ARGS}) ? @{ $args{METHOD_ARGS} } : ();
+  my $cachebase   = exists ($args{CACHEBASE}) ? $args{CACHEBASE} : undef;
+
+  my $rc = 1;
+
+  # Read cache if the file exists
+  # ----------------------------------------------------------------------------
+  my $cache = $cachebase
+              ? File::Spec->catfile ($self->dest->cachedir, $cachebase)
+              : $self->dest->cache;
+  my @in_caches = ();
+  if (-f $cache) {
+    push @in_caches, $cache;
+
+  } else {
+    for my $use (@{ $self->inherit }) {
+      my $use_cache = $cachebase
+                      ? File::Spec->catfile ($use->dest->cachedir, $cachebase)
+                      : $use->dest->cache;
+      push @in_caches, $use_cache if -f $use_cache;
+    }
+  }
+
+  my $old_lines = undef;
+  for my $in_cache (@in_caches) {
+    next unless -f $in_cache;
+    my $cfg = FCM1::CfgFile->new (SRC => $in_cache);
+
+    if ($cfg->read_cfg) {
+      $old_lines = [] if not defined $old_lines;
+      push @$old_lines, @{ $cfg->lines };
+    }
+  }
+
+  # Call methods in @method_list to see if cache is out of date
+  # ----------------------------------------------------------------------------
+  my @new_lines = ();
+  my $out_of_date = 0;
+  for my $method (@method_list) {
+    my ($return, $lines);
+    ($return, $lines) = $self->$method ($old_lines, @method_args) if $rc;
+
+    if (defined $return) {
+      # Method succeeded
+      push @new_lines, @$lines;
+      $out_of_date = 1 if $return;
+
+    } else {
+      # Method failed
+      $rc = $return;
+      last;
+    }
+  }
+
+  # Update the cache in the current run
+  # ----------------------------------------------------------------------------
+  if ($rc) {
+    if (@{ $self->inherited } and $out_of_date) {
+      # If this is an inherited configuration, the cache must not be changed
+      w_report 'ERROR: ', $self->cfg->src,
+               ': inherited configuration does not match with its cache.';
+      $rc = undef;
+
+    } elsif ((not -f $cache) or $out_of_date) {
+      my $cfg = FCM1::CfgFile->new;
+      $cfg->lines ([sort {$a->label cmp $b->label} @new_lines]);
+      $rc = $cfg->print_cfg ($cache, 1);
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($changed_hash_ref, $new_lines_array_ref) =
+#     $self->compare_setting_in_config($prefix, \@old_lines);
+#
+# DESCRIPTION
+#   This method compares old and current settings for a specified item.
+#
+# METHOD
+#   This method does two things.
+#
+#   It uses the current configuration for the $prefix item to generate a list of
+#   new FCM1::CfgLine objects (which is returned as a reference in the second
+#   element of the returned list).
+#
+#   The values of the old lines are then compared with those of the new lines.
+#   Any settings that are changed are stored in a hash, which is returned as a
+#   reference in the first element of the returned list. The key of the hash is
+#   the name of the changed setting, and the value is the value of the new
+#   setting or undef if the setting no longer exists.
+#
+# ARGUMENTS
+#   $prefix    - the name of an item in FCM1::Config to be compared
+#   @old_lines - a list of FCM1::CfgLine objects containing the old settings
+# ------------------------------------------------------------------------------
+
+sub compare_setting_in_config {
+  my ($self, $prefix, $old_lines_ref) = @_;
+  
+  my %changed = %{$self->setting($prefix)};
+  my (@new_lines, %new_val_of);
+  while (my ($key, $val) = each(%changed)) {
+    $new_val_of{$key} = (ref($val) eq 'ARRAY' ? join(q{ }, sort(@{$val})) : $val);
+    push(@new_lines, FCM1::CfgLine->new(
+      LABEL => $prefix . $FCM1::Config::DELIMITER . $key,
+      VALUE => $new_val_of{$key},
+    ));
+  }
+
+  if (defined($old_lines_ref)) {
+    my %old_val_of
+      = map {($_->label_from_field(1), $_->value())} # converts into a hash
+        grep {$_->label_starts_with($prefix)}        # gets relevant lines
+        @{$old_lines_ref};
+
+    while (my ($key, $val) = each(%old_val_of)) {
+      if (exists($changed{$key})) {
+        if ($val eq $new_val_of{$key}) { # no change from old to new
+          delete($changed{$key});
+        }
+      }
+      else { # exists in old but not in new
+        $changed{$key} = undef;
+      }
+    }
+  }
+
+  return (\%changed, \@new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->invoke ([CLEAN => 1, ]%args);
+#
+# DESCRIPTION
+#   This method invokes the system. If CLEAN is set to true, it will only parse
+#   the configuration and set up the destination, but will not invoke the
+#   system. See the invoke_setup_dest and the invoke_system methods for list of
+#   other arguments in %args.
+# ------------------------------------------------------------------------------
+
+sub invoke {
+  my $self = shift;
+  my %args = @_;
+
+  # Print diagnostic at beginning of run
+  # ----------------------------------------------------------------------------
+  # Name of the system
+  (my $name = ref ($self)) =~ s/^FCM1:://;
+
+  # Print start time on system run, if verbose is true
+  my $date = localtime;
+  print $name, ' command started on ', $date, '.', "\n"
+    if $self->verbose;
+
+  # Start time (seconds since epoch)
+  my $otime = time;
+
+  # Parse the configuration file
+  my $rc = $self->invoke_stage ('Parse configuration', 'parse_cfg');
+
+  # Set up the destination
+  $rc = $self->invoke_stage ('Setup destination', 'invoke_setup_dest', %args)
+    if $rc;
+
+  # Invoke the system
+  # ----------------------------------------------------------------------------
+  $rc = $self->invoke_system (%args) if $rc and not $args{CLEAN};
+
+  # Remove empty directories
+  $rc = $self->dest->clean (MODE => 'EMPTY') if $rc;
+
+  # Print diagnostic at end of run
+  # ----------------------------------------------------------------------------
+  # Print lapse time at the end, if verbose is true
+  if ($self->verbose) {
+    my $total = time - $otime;
+    my $s_str = $total > 1 ? 'seconds' : 'second';
+    print '->TOTAL: ', $total, ' ', $s_str, "\n";
+  }
+
+  # Report end of system run
+  $date = localtime;
+  if ($rc) {
+    # Success
+    print $name, ' command finished on ', $date, '.', "\n"
+      if $self->verbose;
+
+  } else {
+    # Failure
+    e_report $name, ' failed on ', $date, '.';
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->invoke_setup_dest ([CLEAN|FULL => 1], [IGNORE_LOCK => 1]);
+#
+# DESCRIPTION
+#   This method sets up the destination and returns true on success.
+#
+# ARGUMENTS
+#   CLEAN|FULL   - If set to "true", set up the system in "clean|full" mode.
+#                  Sub-directories and files in the root directory created by
+#                  the previous invocation of the system will be removed. If
+#                  not set, the default is to run in "incremental" mode.
+#   IGNORE_LOCK  - If set to "true", it ignores any lock files that may exist in
+#                  the destination root directory. 
+# ------------------------------------------------------------------------------
+
+sub invoke_setup_dest {
+  my $self = shift;
+  my %args = @_;
+
+  # Set up destination
+  # ----------------------------------------------------------------------------
+  # Print destination in verbose mode
+  if ($self->verbose()) {
+    printf(
+      "Destination: %s@%s:%s\n",
+      scalar(getpwuid($<)),
+      hostname(),
+      $self->dest()->rootdir(),
+    );
+  }
+
+  my $rc = 1;
+  my $out_of_date = 0;
+
+  # Check whether lock exists in the destination root
+  $rc = $self->check_lock if $rc and not $args{IGNORE_LOCK};
+
+  # Check whether current cache is out of date relative to the inherited ones
+  ($rc, $out_of_date) = $self->check_cache if $rc;
+
+  # Remove sub-directories and files in destination in "full" mode
+  $rc = $self->dest->clean (MODE => 'ALL')
+    if $rc and ($args{FULL} or $args{CLEAN} or $out_of_date);
+
+  # Create build root directory if necessary
+  $rc = $self->dest->create if $rc;
+
+  # Set a lock in the destination root
+  $rc = $self->dest->set_lock if $rc;
+
+  # Generate an as-parsed configuration file
+  $self->cfg->print_cfg ($self->dest->parsedcfg);
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_stage ($name, $method, @args);
+#
+# DESCRIPTION
+#   This method invokes a named stage of the system, where $name is the name of
+#   the stage, $method is the name of the method for invoking the stage and
+#   @args are the arguments to the &method.
+# ------------------------------------------------------------------------------
+
+sub invoke_stage {
+  my ($self, $name, $method, @args) = @_;
+
+  # Print diagnostic at beginning of a stage
+  print '->', $name, ': start', "\n" if $self->verbose;
+  my $stime = time;
+
+  # Invoke the stage
+  my $rc = $self->$method (@args);
+
+  # Print diagnostic at end of a stage
+  my $total = time - $stime;
+  my $s_str = $total > 1 ? 'seconds' : 'second';
+  print '->', $name, ': ', $total, ' ', $s_str, "\n";
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_system (%args);
+#
+# DESCRIPTION
+#   This is a prototype method for invoking the system.
+# ------------------------------------------------------------------------------
+
+sub invoke_system {
+  my $self = shift;
+  my %args = @_;
+
+  print "Dummy code.\n";
+
+  return 0;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->parse_cfg($is_for_inheritance);
+#
+# DESCRIPTION
+#   This method calls other methods to parse the configuration file.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg {
+  my ($self, $is_for_inheritance) = @_;
+
+  # Read config file
+  # ----------------------------------------------------------------------------
+  if (!$self->cfg()->src() || !$self->cfg()->read_cfg($is_for_inheritance)) {
+    return;
+  }
+
+  if ($self->cfg->type ne $self->type) {
+    w_report 'ERROR: ', $self->cfg->src, ': not a ', $self->type,
+             ' config file.';
+    return;
+  }
+
+  # Strip out optional prefix from all labels
+  # ----------------------------------------------------------------------------
+  if ($self->cfg_prefix) {
+    for my $line (@{ $self->cfg->lines }) {
+      $line->prefix ($self->cfg_prefix);
+    }
+  }
+
+  # Filter lines from the configuration file
+  # ----------------------------------------------------------------------------
+  my @cfg_lines = grep {
+    $_->slabel                   and       # ignore empty/comment lines
+    index ($_->slabel, '%') != 0 and       # ignore user variable
+    not $_->slabel_starts_with_cfg ('INC') # ignore INC line
+  } @{ $self->cfg->lines };
+
+  # Parse the lines to read in the various settings, by calling the methods:
+  # $self->parse_cfg_XXX, where XXX is: header, inherit, dest, and the values
+  # in the list @{ $self->cfg_methods }.
+  # ----------------------------------------------------------------------------
+  my $rc = 1;
+  for my $name (@{ $self->cfg_methods }) {
+    my $method = 'parse_cfg_' . $name;
+    $self->$method (\@cfg_lines) or $rc = 0;
+  }
+
+  # Report warnings/errors
+  # ----------------------------------------------------------------------------
+  for my $line (@cfg_lines) {
+    $rc = 0 if not $line->parsed;
+    my $mesg = $line->format_error;
+    w_report $mesg if $mesg;
+  }
+
+  return ($rc);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_dest (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the destination settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_dest {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc = 1;
+
+  # DEST/DIR declarations
+  # ----------------------------------------------------------------------------
+  my @lines  = grep {
+    $_->slabel_starts_with_cfg ('DEST') or $_->slabel_starts_with_cfg ('DIR')
+  } @$cfg_lines;
+
+  # Only ROOTDIR declarations are accepted
+  for my $line (@lines) {
+    my ($d, $method) = $line->slabel_fields;
+    $d = lc $d;
+    if ($method) {
+      $method = lc($method);
+    }
+
+    # Backward compatibility
+    $d = 'dest' if $d eq 'dir';
+
+    # Default to "rootdir"
+    $method = 'rootdir' if (not $method) or $method eq 'root';
+
+    # Only "rootdir" can be set
+    next unless $method eq 'rootdir';
+
+    $self->$d->$method (&expand_tilde ($line->value));
+    $line->parsed (1);
+  }
+
+  # Make sure root directory is set
+  # ----------------------------------------------------------------------------
+  if (not $self->dest->rootdir) {
+    w_report 'ERROR: ', $self->cfg->actual_src,
+             ': destination root directory not set.';
+    $rc = 0;
+  }
+
+  # Inherit destinations
+  # ----------------------------------------------------------------------------
+  @{$self->dest()->inherit()} = ();
+  my @nodes = @{$self->inherit()};
+  while (my $node = pop(@nodes)) {
+      push(@nodes, @{$node->inherit()});
+      push(@{$self->dest()->inherit()}, $node->dest());
+  }
+  @{$self->dest()->inherit()} = reverse(@{$self->dest()->inherit()});
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_header (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the header setting in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_header {
+  my ($self, $cfg_lines) = @_;
+
+  # Set header lines as "parsed"
+  map {$_->parsed (1)} grep {$_->slabel_starts_with_cfg ('CFGFILE')} @$cfg_lines;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_inherit (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the inherit setting in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_inherit {
+  my ($self, $cfg_lines) = @_;
+
+  # USE declaration
+  # ----------------------------------------------------------------------------
+  my @lines = grep {$_->slabel_starts_with_cfg ('USE')} @$cfg_lines;
+
+  # Check for cyclic dependency
+  if (@lines and grep {$_ eq $self->cfg->actual_src} @{ $self->inherited }) {
+    # Error if current configuration file is in its own inheritance hierarchy
+    w_report 'ERROR: ', $self->cfg->actual_src, ': attempt to inherit itself.';
+    $_->error ($_->label . ': ignored due to cyclic dependency.') for (@lines);
+    return 0;
+  }
+
+  my $rc = 1;
+
+  for my $line (@lines) {
+    # Invoke new instance of the current class
+    my $use = ref ($self)->new;
+
+    # Set configuration file, inheritance hierarchy
+    # and attempt to parse the configuration
+    $use->cfg->src  (&expand_tilde ($line->value));
+    $use->inherited ([$self->cfg->actual_src, @{ $self->inherited }]);
+    $use->parse_cfg(1); # 1 = is for inheritance
+
+    # Add to list of inherit configurations
+    push @{ $self->inherit }, $use;
+
+    $line->parsed (1);
+  }
+
+  # Check locks in inherited destination
+  # ----------------------------------------------------------------------------
+  for my $use (@{ $self->inherit }) {
+    $rc = 0 unless $use->check_lock;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines ();
+#
+# DESCRIPTION
+#   This method returns the configuration lines of this object.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines {
+  my ($self) = @_;
+
+  my @inherited_dests = map {
+    FCM1::CfgLine->new (
+      label => $self->cfglabel ('USE'), value => $_->dest->rootdir
+    );
+  } @{ $self->inherit };
+
+  return (
+    FCM1::CfgLine::comment_block ('File header'),
+    FCM1::CfgLine->new (
+      label => $self->cfglabel ('CFGFILE') . $FCM1::Config::DELIMITER . 'TYPE',
+      value => $self->type,
+    ),
+    FCM1::CfgLine->new (
+      label => $self->cfglabel ('CFGFILE') . $FCM1::Config::DELIMITER . 'VERSION',
+      value => '1.0',
+    ),
+    FCM1::CfgLine->new (),
+
+    @inherited_dests,
+
+    FCM1::CfgLine::comment_block ('Destination'),
+    ($self->dest->to_cfglines()),
+  );
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Dest.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Dest.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Dest.pm	(revision 5095)
@@ -0,0 +1,899 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::Dest
+#
+# DESCRIPTION
+#   This class contains methods to set up a destination location of an FCM
+#   extract/build.
+#
+# ------------------------------------------------------------------------------
+use warnings;
+use strict;
+
+package FCM1::Dest;
+use base qw{FCM1::Base};
+
+use Carp             qw{croak}                          ;
+use Cwd              qw{cwd}                            ;
+use FCM1::CfgLine                                       ;
+use FCM1::Timer      qw{timestamp_command}              ;
+use FCM1::Util       qw{run_command touch_file w_report};
+use File::Basename   qw{basename dirname}               ;
+use File::Find       qw{find}                           ;
+use File::Path       qw{mkpath rmtree}                  ;
+use File::Spec                                          ;
+use Sys::Hostname    qw{hostname}                       ;
+use Text::ParseWords qw{shellwords}                     ;
+
+# Useful variables
+# ------------------------------------------------------------------------------
+# List of configuration files
+our @cfgfiles = (
+  'bldcfg',     # default location of the build configuration file
+  'extcfg',     # default location of the extract configuration file
+);
+
+# List of cache and configuration files, according to the dest type
+our @cfgfiles_type = (
+  'cache',     # default location of the cache file
+  'cfg',       # default location of the configuration file
+  'parsedcfg', # default location of the as-parsed configuration file
+);
+
+# List of lock files
+our @lockfiles = (
+  'bldlock',    # the build lock file
+  'extlock',    # the extract lock file
+);
+
+# List of misc files
+our @miscfiles_bld = (
+  'bldrunenvsh', # the build run environment shell script
+  'bldmakefile', # the build Makefile
+);
+
+# List of sub-directories created by extract
+our @subdirs_ext = (
+  'cfgdir',     # sub-directory for configuration files
+  'srcdir',     # sub-directory for source tree
+);
+
+# List of sub-directories that can be archived by "tar" at end of build
+our @subdirs_tar = (
+  'donedir',    # sub-directory for "done" files
+  'flagsdir',   # sub-directory for "flags" files
+  'incdir',     # sub-directory for include files
+  'ppsrcdir',   # sub-directory for pre-process source tree
+  'objdir',     # sub-directory for object files
+);
+
+# List of sub-directories created by build
+our @subdirs_bld = (
+  'bindir',     # sub-directory for executables
+  'etcdir',     # sub-directory for miscellaneous files
+  'libdir',     # sub-directory for object libraries
+  'tmpdir',     # sub-directory for temporary build files
+  @subdirs_tar, # -see above-
+);
+
+# List of sub-directories under rootdir
+our @subdirs = (
+  'cachedir',   # sub-directory for caches
+  @subdirs_ext, # -see above-
+  @subdirs_bld, # -see above-
+);
+
+# List of inherited search paths
+# "rootdir" + all @subdirs, with "XXXdir" replaced with "XXXpath"
+our @paths = (
+    'rootpath',
+    (map {my $key = $_; $key =~ s{dir\z}{path}msx; $key} @subdirs),
+);
+
+# List of properties and their default values.
+my %PROP_OF = (
+  # the original destination (if current destination is a mirror)
+  'dest0'                => undef,
+  # list of inherited FCM1::Dest objects
+  'inherit'              => [],
+  # remote login name
+  'logname'              => scalar(getpwuid($<)),
+  # lock file
+  'lockfile'             => undef,
+  # remote machine
+  'machine'              => hostname(),
+  # mirror command to use
+  'mirror_cmd'           => 'rsync',
+  # (for rsync) remote mkdir, the remote shell command
+  'rsh_mkdir_rsh'        => 'ssh',
+  # (for rsync) remote mkdir, the remote shell command flags
+  'rsh_mkdir_rshflags'   => '-n -oBatchMode=yes',
+  # (for rsync) remote mkdir, the remote shell command
+  'rsh_mkdir_mkdir'      => 'mkdir',
+  # (for rsync) remote mkdir, the remote shell command flags
+  'rsh_mkdir_mkdirflags' => '-p',
+  # (for rsync) remote mkdir, the remote shell command
+  'rsync'                => 'rsync',
+  # (for rsync) remote mkdir, the remote shell command flags
+  'rsyncflags'           => q{-a --exclude='.*' --delete-excluded}
+                            . q{ --timeout=900 --rsh='ssh -oBatchMode=yes'},
+  # destination root directory
+  'rootdir'              => undef,
+  # destination type, "bld" (default) or "ext"
+  'type'                 => 'bld',
+);
+# Hook for property setter
+my %PROP_HOOK_OF = (
+  'inherit' => \&_reset_inherit,
+  'rootdir' => \&_reset_rootdir,
+);
+
+# Mirror implementations
+my %MIRROR_IMPL_OF = (
+  rdist => \&_mirror_with_rdist,
+  rsync => \&_mirror_with_rsync,
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::Dest->new(%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::Dest class. See above for
+#   allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my ($class, %args) = @_;
+  my $self = bless(FCM1::Base->new(%args), $class);
+  while (my ($key, $value) = each(%args)) {
+    $key = lc($key);
+    if (exists($PROP_OF{$key})) {
+        $self->{$key} = $value;
+    }
+  }
+  for my $key (@subdirs, @paths, @lockfiles, @cfgfiles) {
+    $self->{$key} = undef;
+  }
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->DESTROY;
+#
+# DESCRIPTION
+#   This method is called automatically when the FCM1::Dest object is
+#   destroyed.
+# ------------------------------------------------------------------------------
+
+sub DESTROY {
+  my $self = shift;
+
+  # Remove the lockfile if it is set
+  unlink $self->lockfile if $self->lockfile and -f $self->lockfile;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in %PROP_OF.
+# ------------------------------------------------------------------------------
+
+while (my ($key, $default) = each(%PROP_OF)) {
+  no strict 'refs';
+  *{$key} = sub {
+    my $self = shift();
+    # Set property to specified value
+    if (@_) {
+      $self->{$key} = $_[0];
+      if (exists($PROP_HOOK_OF{$key})) {
+        $PROP_HOOK_OF{$key}->($self, $key);
+      }
+    }
+    # Sets default where possible
+    if (!defined($self->{$key})) {
+      $self->{$key} = $default;
+    }
+    return $self->{$key};
+  };
+}
+
+# Remote shell property: deprecated.
+sub remote_shell {
+  my $self = shift();
+  $self->rsh_mkdir_rsh(@_);
+}
+
+# Resets properties associated with root directory.
+sub _reset_rootdir {
+  my $self = shift();
+  for my $key (@cfgfiles, @lockfiles, @miscfiles_bld, @subdirs) {
+    $self->{$key} = undef;
+  }
+}
+
+# Reset properties associated with inherited paths.
+sub _reset_inherit {
+  my $self = shift();
+  for my $key (@paths) {
+    $self->{$key} = undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#
+# DESCRIPTION
+#   This method returns X, where X is a location derived from rootdir, and can
+#   be one of:
+#     bindir, bldcfg, blddir, bldlock, bldrunenv, cache, cachedir, cfg, cfgdir,
+#     donedir, etcdir, extcfg, extlock, flagsdir, incdir, libdir, parsedcfg,
+#     ppsrcdir, objdir, or tmpdir.
+#
+#   Details of these properties are explained earlier.
+# ------------------------------------------------------------------------------
+
+for my $name (@cfgfiles, @cfgfiles_type, @lockfiles, @miscfiles_bld, @subdirs) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # If variable not set, derive it from rootdir
+    if ($self->rootdir and not defined $self->{$name}) {
+      if ($name eq 'cache') {
+        # Cache file under root/.cache
+        $self->{$name} =  File::Spec->catfile (
+          $self->cachedir, $self->setting ('CACHE'),
+        );
+
+      } elsif ($name eq 'cfg') {
+        # Configuration file of current type
+        my $method = $self->type . 'cfg';
+        $self->{$name} = $self->$method;
+
+      } elsif (grep {$name eq $_} @cfgfiles) {
+        # Configuration files under the root/cfg
+        (my $label = uc ($name)) =~ s/CFG//;
+        $self->{$name} = File::Spec->catfile (
+          $self->cfgdir, $self->setting ('CFG_NAME', $label),
+        );
+
+      } elsif (grep {$name eq $_} @lockfiles) {
+        # Lock file
+        $self->{$name} = File::Spec->catfile (
+          $self->rootdir, $self->setting ('LOCK', uc ($name)),
+        );
+
+      } elsif (grep {$name eq $_} @miscfiles_bld) {
+        # Misc file
+        $self->{$name} = File::Spec->catfile (
+          $self->rootdir, $self->setting ('BLD_MISC', uc ($name)),
+        );
+
+      } elsif ($name eq 'parsedcfg') {
+        # As-parsed configuration file of current type
+        $self->{$name} = File::Spec->catfile (
+          dirname ($self->cfg),
+          $self->setting (qw/CFG_NAME PARSED/) . basename ($self->cfg),
+        )
+
+      } elsif (grep {$name eq $_} @subdirs) {
+        # Sub-directories under the root
+        (my $label = uc ($name)) =~ s/DIR//;
+        $self->{$name} = File::Spec->catfile (
+          $self->rootdir,
+          $self->setting ('DIR', $label),
+          ($name eq 'cachedir' ? '.' . $self->type : ()),
+        );
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#
+# DESCRIPTION
+#   This method returns X, an array containing the search path of a destination
+#   directory, which can be one of:
+#     binpath, bldpath, cachepath, cfgpath, donepath, etcpath, flagspath,
+#     incpath, libpath, ppsrcpath, objpath, rootpath, srcpath, or tmppath,
+#
+#   Details of these properties are explained earlier.
+# ------------------------------------------------------------------------------
+
+for my $name (@paths) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    (my $dir = $name) =~ s/path/dir/;
+
+    if ($self->$dir and not defined $self->{$name}) {
+      my @path = ();
+
+      # Recursively inherit the search path
+      for my $d (@{ $self->inherit }) {
+        unshift @path, $d->$dir;
+      }
+
+      # Place the path of the current build in the front
+      unshift @path, $self->$dir;
+
+      $self->{$name} = \@path;
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->archive ();
+#
+# DESCRIPTION
+#   This method creates TAR archives for selected sub-directories.
+# ------------------------------------------------------------------------------
+
+sub archive {
+  my $self = shift;
+
+  # Save current directory
+  my $cwd = cwd ();
+
+  my $tar      = $self->setting (qw/OUTFILE_EXT TAR/);
+  my $verbose  = $self->verbose;
+
+  for my $name (@subdirs_tar) {
+    my $dir = $self->$name;
+
+    # Ignore unless sub-directory exists
+    next unless -d $dir;
+
+    # Change to container directory
+    my $base = basename ($dir);
+    print 'cd ', dirname ($dir), "\n" if $verbose > 2;
+    chdir dirname ($dir);
+
+    # Run "tar" command
+    my $rc = &run_command (
+      [qw/tar -czf/, $base . $tar, $base],
+      PRINT => $verbose > 1, ERROR => 'warn',
+    );
+
+    # Remove sub-directory
+    &run_command ([qw/rm -rf/, $base], PRINT => $verbose > 1) if not $rc;
+  }
+
+  # Change back to "current" directory
+  print 'cd ', $cwd, "\n" if $verbose > 2;
+  chdir $cwd;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $authority = $obj->authority();
+#
+# DESCRIPTION
+#   Returns LOGNAME@MACHINE for this destination if LOGNAME is defined and not
+#   the same as the user ID of the current process. Returns MACHINE if LOGNAME
+#   is the same as the user ID of the current process, but MACHINE is not the
+#   same as the current hostname. Returns an empty string if LOGNAME and
+#   MACHINE are not defined or are the same as in the current process.
+# ------------------------------------------------------------------------------
+
+sub authority {
+  my $self = shift;
+  my $return = '';
+
+  if ($self->logname ne $self->config->user_id) {
+    $return = $self->logname . '@' . $self->machine;
+
+  } elsif ($self->machine ne &hostname()) {
+    $return = $self->machine;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->clean([ITEM => <list>,] [MODE => 'ALL|CONTENT|EMPTY',]);
+#
+# DESCRIPTION
+#   This method removes files/directories from the destination. If ITEM is set,
+#   it must be a reference to a list of method names for files/directories to
+#   be removed. Otherwise, the list is determined by the destination type. If
+#   MODE is ALL, all directories/files created by the extract/build are
+#   removed. If MODE is CONTENT, only contents within sub-directories are
+#   removed. If MODE is EMPTY (default), only empty sub-directories are
+#   removed.
+# ------------------------------------------------------------------------------
+
+sub clean {
+  my ($self, %args) = @_;
+  my $mode = exists $args{MODE} ? $args{MODE} : 'EMPTY';
+  my $rc = 1;
+  my @names
+    = $args{ITEM}            ? @{$args{ITEM}}
+    : $self->type() eq 'ext' ? ('cachedir', @subdirs_ext)
+    :                          ('cachedir', @subdirs_bld, @miscfiles_bld)
+    ;
+  my @items;
+  if ($mode eq 'CONTENT') {
+    for my $name (@names) {
+      my $item = $self->$name();
+      push(@items, _directory_contents($item));
+    }
+  }
+  else {
+    for my $name (@names) {
+      my $item = $self->$name();
+      if ($mode eq 'ALL' || -d $item && !_directory_contents($item)) {
+        push(@items, $item);
+      }
+    }
+  }
+  for my $item (@items) {
+    if ($self->verbose() >= 2) {
+      printf("%s: remove\n", $item);
+    }
+    eval {rmtree($item)};
+    if ($@) {
+      w_report($@);
+      $rc = 0;
+    }
+  }
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->create ([DIR => <dir-list>,]);
+#
+# DESCRIPTION
+#   This method creates the directories of a destination. If DIR is set, it
+#   must be a reference to a list of sub-directories to be created.  Otherwise,
+#   the sub-directory list is determined by the destination type. It returns
+#   true if the destination is created or if it exists and is writable.
+# ------------------------------------------------------------------------------
+
+sub create {
+  my ($self, %args) = @_;
+
+  my $rc = 1;
+
+  my @dirs;
+  if (exists $args{DIR} and $args{DIR}) {
+    # Create only selected sub-directories
+    @dirs = @{ $args{DIR} };
+
+  } else {
+    # Create rootdir, cachedir and read-write sub-directories for extract/build
+    @dirs = (
+      qw/rootdir cachedir/,
+      ($self->type eq 'ext' ? @subdirs_ext : @subdirs_bld),
+    );
+  }
+
+  for my $name (@dirs) {
+    my $dir = $self->$name;
+
+    # Create directory if it does not already exist
+    if (not -d $dir) {
+      print 'Make directory: ', $dir, "\n" if $self->verbose > 1;
+      mkpath $dir;
+    }
+
+    # Check whether directory exists and is writable
+    if (!-d $dir) {
+      w_report 'ERROR: ', $dir, ': cannot create destination.';
+      $rc = 0;
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->create_bldrunenvsh ();
+#
+# DESCRIPTION
+#   This method creates the runtime environment script for the build.
+# ------------------------------------------------------------------------------
+
+sub create_bldrunenvsh {
+  my $self = shift;
+
+  # Path to executable files and directory for misc files
+  my @bin_paths = grep {_directory_contents($_)} @{$self->binpath()};
+  my $bin_dir = -d $self->bindir() ? $self->bindir() : undef;
+  my $etc_dir = _directory_contents($self->etcdir()) ? $self->etcdir() : undef;
+
+  # Create a runtime environment script if necessary
+  if (@bin_paths || $etc_dir) {
+    my $path = $self->bldrunenvsh();
+    open(my $handle, '>', $path) || croak("$path: cannot open ($!)\n");
+    printf($handle "#!%s\n", $self->setting(qw/TOOL SHELL/));
+    if (@bin_paths) {
+      printf($handle "PATH=%s:\$PATH\n", join(':', @bin_paths));
+      print($handle "export PATH\n");
+    }
+    if ($etc_dir) {
+      printf($handle "FCM_ETCDIR=%s\n", $etc_dir);
+      print($handle "export FCM_ETCDIR\n");
+    }
+    close($handle) || croak("$path: cannot close ($!)\n");
+
+    # Create symbolic links fcm_env.ksh and bin/fcm_env.ksh for backward
+    # compatibility
+    my $FCM_ENV_KSH = 'fcm_env.ksh';
+    for my $link (
+      File::Spec->catfile($self->rootdir, $FCM_ENV_KSH),
+      ($bin_dir ? File::Spec->catfile($bin_dir, $FCM_ENV_KSH) : ()),
+    ) {
+      if (-l $link && readlink($link) ne $path || -e $link) {
+        unlink($link);
+      }
+      if (!-l $link) {
+        symlink($path, $link) || croak("$link: cannot create symbolic link\n");
+      }
+    }
+  }
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->dearchive ();
+#
+# DESCRIPTION
+#   This method extracts from TAR archives for selected sub-directories.
+# ------------------------------------------------------------------------------
+
+sub dearchive {
+  my $self = shift;
+
+  my $tar     = $self->setting (qw/OUTFILE_EXT TAR/);
+  my $verbose = $self->verbose;
+
+  # Extract archives if necessary
+  for my $name (@subdirs_tar) {
+    my $tar_file = $self->$name . $tar;
+
+    # Check whether tar archive exists for the named sub-directory
+    next unless -f $tar_file;
+
+    # If so, extract the archive and remove it afterwards
+    &run_command ([qw/tar -xzf/, $tar_file], PRINT => $verbose > 1);
+    &run_command ([qw/rm -f/, $tar_file], PRINT => $verbose > 1);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $obj->get_pkgname_of_path ($path);
+#
+# DESCRIPTION
+#   This method returns the package name of $path if $path is in (a relative
+#   path of) $self->srcdir, or undef otherwise.
+# ------------------------------------------------------------------------------
+
+sub get_pkgname_of_path {
+  my ($self, $path) = @_;
+
+  my $relpath = File::Spec->abs2rel ($path, $self->srcdir);
+  my $name = $relpath ? [File::Spec->splitdir ($relpath)] : undef;
+
+  return $name;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %src = $obj->get_source_files ();
+#
+# DESCRIPTION
+#   This method returns a hash (keys = package names, values = file names)
+#   under $self->srcdir.
+# ------------------------------------------------------------------------------
+
+sub get_source_files {
+  my $self = shift;
+
+  my %src;
+  if ($self->srcdir and -d $self->srcdir) {
+    &find (sub {
+      return if /^\./;                    # ignore system/hidden file
+      return if -d $File::Find::name;     # ignore directory
+
+      my $name = join (
+        '__', @{ $self->get_pkgname_of_path ($File::Find::name) },
+      );
+      $src{$name} = $File::Find::name;
+    }, $self->srcdir);
+  }
+
+  return \%src;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->mirror (\@items);
+#
+# DESCRIPTION
+#   This method mirrors @items (list of method names for directories or files)
+#   from $dest0 (which must be an instance of FCM1::Dest for a local
+#   destination) to this destination.
+# ------------------------------------------------------------------------------
+
+sub mirror {
+  my ($self, $items_ref) = @_;
+  if ($self->authority() || $self->dest0()->rootdir() ne $self->rootdir()) {
+    # Diagnostic
+    if ($self->verbose()) {
+      printf(
+        "Destination: %s\n",
+        ($self->authority() ? $self->authority() . q{:} : q{}) . $self->rootdir()
+      );
+    }
+    if ($MIRROR_IMPL_OF{$self->mirror_cmd()}) {
+      $MIRROR_IMPL_OF{$self->mirror_cmd()}->($self, $self->dest0(), $items_ref);
+    }
+    else {
+      # Unknown mirroring tool
+      w_report($self->mirror_cmd, ': unknown mirroring tool, abort.');
+      return 0;
+    }
+  }
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_mirror_with_rdist ($dest0, \@items);
+#
+# DESCRIPTION
+#   This internal method implements $self->mirror with "rdist".
+# ------------------------------------------------------------------------------
+
+sub _mirror_with_rdist {
+  my ($self, $dest0, $items) = @_;
+
+  my $rhost = $self->authority ? $self->authority : &hostname();
+
+  # Print distfile content to temporary file
+  my @distfile = ();
+  for my $label (@$items) {
+    push @distfile, '( ' . $dest0->$label . ' ) -> ' . $rhost . "\n";
+    push @distfile, '  install ' . $self->$label . ';' . "\n";
+  }
+
+  # Set up mirroring command (use "rdist" at the moment)
+  my $command = 'rdist -R';
+  $command   .= ' -q' unless $self->verbose > 1;
+  $command   .= ' -f - 1>/dev/null';
+
+  # Diagnostic
+  my $croak = 'Cannot execute "' . $command . '"';
+  if ($self->verbose > 2) {
+    print timestamp_command ($command, 'Start');
+    print '  ', $_ for (@distfile);
+  }
+
+  # Execute the mirroring command
+  open COMMAND, '|-', $command or croak $croak, ' (', $!, '), abort';
+  for my $line (@distfile) {
+    print COMMAND $line;
+  }
+  close COMMAND or croak $croak, ' (', $?, '), abort';
+
+  # Diagnostic
+  print timestamp_command ($command, 'End  ') if $self->verbose > 2;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_mirror_with_rsync($dest0, \@items);
+#
+# DESCRIPTION
+#   This internal method implements $self->mirror() with "rsync".
+# ------------------------------------------------------------------------------
+
+sub _mirror_with_rsync {
+  my ($self, $dest0, $items_ref) = @_;
+  my @rsh_mkdir;
+  if ($self->authority()) {
+    @rsh_mkdir = (
+        $self->rsh_mkdir_rsh(),
+        shellwords($self->rsh_mkdir_rshflags()),
+        $self->authority(),
+        $self->rsh_mkdir_mkdir(),
+        shellwords($self->rsh_mkdir_mkdirflags()),
+    );
+  }
+  my @rsync = ($self->rsync(), shellwords($self->rsyncflags()));
+  my @rsync_verbose = ($self->verbose() > 2 ? '-v' : ());
+  my $auth = $self->authority() ? $self->authority() . q{:} : q{};
+  for my $item (@{$items_ref}) {
+    # Create container directory, as rsync does not do it automatically
+    my $dir = dirname($self->$item());
+    if (@rsh_mkdir) {
+      run_command([@rsh_mkdir, $dir], TIME => $self->verbose() > 2);
+    }
+    else {
+      mkpath($dir);
+    }
+    run_command(
+      [@rsync, @rsync_verbose, $dest0->$item(), $auth . $dir],
+      TIME => $self->verbose > 2,
+    );
+  }
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->set_lock ();
+#
+# DESCRIPTION
+#   This method sets a lock in the current destination.
+# ------------------------------------------------------------------------------
+
+sub set_lock {
+  my $self = shift;
+
+  $self->lockfile ();
+
+  if ($self->type eq 'ext' and not $self->dest0) {
+    # Only set an extract lock for the local destination
+    $self->lockfile ($self->extlock);
+
+  } elsif ($self->type eq 'bld') {
+    # Set a build lock
+    $self->lockfile ($self->bldlock);
+  }
+
+  return &touch_file ($self->lockfile) if $self->lockfile;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines ([$index]);
+#
+# DESCRIPTION
+#   This method returns a list of configuration lines for the current
+#   destination. If it is set, $index is the index number of the current
+#   destination.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines {
+  my ($self, $index) = @_;
+
+  my $PREFIX = $self->cfglabel($self->dest0() ? 'RDEST' : 'DEST');
+  my $SUFFIX = ($index ? $FCM1::Config::DELIMITER . $index : q{});
+
+  my @return = (
+    FCM1::CfgLine->new(label => $PREFIX . $SUFFIX, value => $self->rootdir()),
+  );
+  if ($self->dest0()) {
+    for my $name (qw{
+      logname
+      machine
+      mirror_cmd
+      rsh_mkdir_rsh
+      rsh_mkdir_rshflags
+      rsh_mkdir_mkdir
+      rsh_mkdir_mkdirflags
+      rsync
+      rsyncflags
+    }) {
+      if ($self->{$name} && $self->{$name} ne $PROP_OF{$name}) { # not default
+        push(
+          @return,
+          FCM1::CfgLine->new(
+            label => $PREFIX . $FCM1::Config::DELIMITER . uc($name) . $SUFFIX,
+            value => $self->{$name},
+          ),
+        );
+      }
+    }
+  }
+
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->write_rules ();
+#
+# DESCRIPTION
+#   This method returns a string containing Makefile variable declarations for
+#   directories and search paths in this destination.
+# ------------------------------------------------------------------------------
+
+sub write_rules {
+  my $self   = shift;
+  my $return = '';
+
+  # FCM_*DIR*
+  for my $i (0 .. @{ $self->inherit }) {
+    for my $name (@paths) {
+      (my $label = $name) =~ s/path$/dir/;
+      my $dir = $name eq 'rootpath' ? $self->$name->[$i] : File::Spec->catfile (
+        '$(FCM_ROOTDIR' . ($i ? $i : '') . ')',
+        File::Spec->abs2rel ($self->$name->[$i], $self->rootpath->[$i]),
+      );
+
+      $return .= ($i ? '' : 'export ') . 'FCM_' . uc ($label) . ($i ? $i : '') .
+                 ' := ' . $dir . "\n";
+    }
+  }
+
+  # FCM_*PATH
+  for my $name (@paths) {
+    (my $label = $name) =~ s/path$/dir/;
+
+    $return .= 'export FCM_' . uc ($name) . ' := ';
+    for my $i (0 .. @{ $self->$name } - 1) {
+      $return .= ($i ? ':' : '') . '$(FCM_' . uc ($label) . ($i ? $i : '') . ')';
+    }
+    $return .= "\n";
+  }
+
+  $return .= "\n";
+
+  return $return;
+}
+
+# Returns contents in directory.
+sub _directory_contents {
+  my $path = shift();
+  if (!-d $path) {
+    return;
+  }
+  opendir(my $handle, $path) || croak("$path: cannot open directory ($!)\n");
+  my @items = grep {$_ ne q{.} && $_ ne q{..}} readdir($handle);
+  closedir($handle);
+  map {File::Spec->catfile($path . $_)} @items;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Exception.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Exception.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Exception.pm	(revision 5095)
@@ -0,0 +1,108 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package FCM1::Exception;
+use overload (q{""} => \&as_string);
+
+use Scalar::Util qw{blessed};
+
+# ------------------------------------------------------------------------------
+# Returns true if $e is a blessed instance of this class.
+sub caught {
+    my ($class, $e) = @_;
+    return (blessed($e) && $e->isa($class));
+}
+
+# ------------------------------------------------------------------------------
+# Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless(
+        {message => q{unknown problem}, ($args_ref ? %{$args_ref} : ())},
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Returns a string representation of this exception
+sub as_string {
+    my ($self) = @_;
+    return sprintf("%s: %s\n", blessed($self), $self->get_message());
+}
+
+# ------------------------------------------------------------------------------
+# Returns the message of this exception
+sub get_message {
+    my ($self) = @_;
+    return $self->{message};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM1::Exception
+
+=head1 SYNOPSIS
+
+    use FCM1::Exception;
+    eval {
+        croak(FCM1::Exception->new({message => $message}));
+    };
+    if ($@) {
+        if (FCM1::Exception->caught($@)) {
+            print({STDERR} $@);
+        }
+    }
+
+=head1 DESCRIPTION
+
+This exception is raised when there is a generic problem in FCM.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->caught($e)
+
+Returns true if $e is a blessed instance of this class.
+
+=item $class->new({message=E<gt>$message})
+
+Returns a new instance of this exception. Its first argument must be a
+reference to a hash containing the detailed I<message> of the exception.
+
+=item $e->as_string()
+
+Returns a string representation of this exception.
+
+=item $e->get_message()
+
+Returns the detailed message of this exception.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Extract.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Extract.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Extract.pm	(revision 5095)
@@ -0,0 +1,1132 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::Extract
+#
+# DESCRIPTION
+#   This is the top level class for the FCM extract system.
+#
+# ------------------------------------------------------------------------------
+
+package FCM1::Extract;
+@ISA = qw(FCM1::ConfigSystem);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use File::Path;
+use File::Spec;
+
+# FCM component modules
+use FCM1::CfgFile;
+use FCM1::CfgLine;
+use FCM1::Config;
+use FCM1::ConfigSystem;
+use FCM1::Dest;
+use FCM1::ExtractFile;
+use FCM1::ExtractSrc;
+use FCM1::Keyword;
+use FCM1::ReposBranch;
+use FCM1::SrcDirLayer;
+use FCM1::Util;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+ 'bdeclare', # list of build declarations
+ 'branches', # list of repository branches
+ 'conflict', # conflict mode
+ 'rdest'   , # remote destination information
+);
+
+# List of hash property methods for this class
+my @hash_properties = (
+ 'srcdirs' , # list of source directory extract info
+ 'files',    # list of files processed key=pkgname, value=FCM1::ExtractFile
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::Extract->new;
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::Extract class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = FCM1::ConfigSystem->new (%args);
+
+  $self->{$_} = undef for (@scalar_properties);
+
+  $self->{$_} = {} for (@hash_properties);
+
+  bless $self, $class;
+
+  # List of sub-methods for parse_cfg
+  push @{ $self->cfg_methods }, (qw/rdest bld conflict project/);
+
+  # System type
+  $self->type ('ext');
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'bdeclare' or $name eq 'branches') {
+        # Reference to an array
+        $self->{$name} = [];
+
+      } elsif ($name eq 'rdest') {
+        # New extract destination local/remote
+        $self->{$name} = FCM1::Dest->new (DEST0 => $self->dest(), TYPE => 'ext');
+
+      } elsif ($name eq 'conflict') {
+        # Conflict mode, default to "merge"
+        $self->{$name} = 'merge';
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @hash_properties.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (@hash_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    $self->{$name} = {} if not defined ($self->{$name});
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->check_lock_is_allowed ($lock);
+#
+# DESCRIPTION
+#   This method returns true if it is OK for $lock to exist in the destination.
+# ------------------------------------------------------------------------------
+
+sub check_lock_is_allowed {
+  my ($self, $lock) = @_;
+
+  # Allow existence of build lock in inherited extract
+  return ($lock eq $self->dest->bldlock and @{ $self->inherited });
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_extract ();
+#
+# DESCRIPTION
+#   This method invokes the extract stage of the extract system. It returns
+#   true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_extract {
+  my $self = shift;
+
+  my $rc = 1;
+
+  my @methods = (
+    'expand_cfg',       # expand URL, revision keywords, relative path, etc
+    'create_dir_stack', # analyse the branches to create an extract sequence
+    'extract_src',      # use the sequence to extract source to destination
+    'write_cfg',        # generate final configuration file
+    'write_cfg_bld',    # generate build configuration file
+  );
+
+  for my $method (@methods) {
+    $rc = $self->$method if $rc;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_mirror ();
+#
+# DESCRIPTION
+#   This method invokes the mirror stage of the extract system. It returns
+#   true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_mirror {
+  my $self = shift;
+  return $self->rdest->mirror ([qw/bldcfg extcfg srcdir/]);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_system ();
+#
+# DESCRIPTION
+#   This method invokes the extract system. It returns true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_system {
+  my $self = shift;
+
+  my $rc = 1;
+  
+  $rc = $self->invoke_stage ('Extract', 'invoke_extract');
+  $rc = $self->invoke_stage ('Mirror', 'invoke_mirror')
+    if $rc and $self->rdest->rootdir;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_rdest(\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the remote destination settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_rdest {
+  my ($self, $cfg_lines_ref) = @_;
+
+  # RDEST declarations
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg('RDEST')} @{$cfg_lines_ref}) {
+    my ($d, $method) = map {lc($_)} $line->slabel_fields();
+    $method ||= 'rootdir';
+    if ($self->rdest()->can($method)) {
+      $self->rdest()->$method(expand_tilde($line->value()));
+      $line->parsed(1);
+    }
+  }
+
+  # MIRROR declaration, deprecated = RDEST::MIRROR_CMD
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg('MIRROR')} @{$cfg_lines_ref}) {
+    $self->rdest()->mirror_cmd($line->value());
+    $line->parsed(1);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_bld (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the build configurations in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_bld {
+  my ($self, $cfg_lines) = @_;
+
+  # BLD declarations
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('BDECLARE')} @$cfg_lines) {
+    # Remove BLD from label
+    my @words = $line->slabel_fields;
+
+    # Check that a declaration follows BLD
+    next if @words <= 1;
+
+    push @{ $self->bdeclare }, FCM1::CfgLine->new (
+      LABEL  => join ($FCM1::Config::DELIMITER, @words),
+      PREFIX => $self->cfglabel ('BDECLARE'),
+      VALUE  => $line->value,
+    );
+    $line->parsed (1);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_conflict (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the conflict settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_conflict {
+  my ($self, $cfg_lines) = @_;
+
+  # Deprecated: Override mode setting
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('OVERRIDE')} @$cfg_lines) {
+    next if ($line->slabel_fields) > 1;
+    $self->conflict ($line->bvalue ? 'override' : 'fail');
+    $line->parsed (1);
+    $line->warning($line->slabel . ' is deprecated. Use ' .
+                   $line->cfglabel('CONFLICT') . ' override|merge|fail.');
+  }
+
+  # Conflict mode setting
+  # ----------------------------------------------------------------------------
+  my @conflict_modes = qw/fail merge override/;
+  my $conflict_modes_pattern = join ('|', @conflict_modes);
+  for my $line (grep {$_->slabel_starts_with_cfg ('CONFLICT')} @$cfg_lines) {
+    if ($line->value =~ /$conflict_modes_pattern/i) {
+      $self->conflict (lc ($line->value));
+      $line->parsed (1);
+
+    } elsif ($line->value =~ /^[012]$/) {
+      $self->conflict ($conflict_modes[$line->value]);
+      $line->parsed (1);
+
+    } else {
+      $line->error ($line->value, ': invalid value');
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_project (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the project settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_project {
+  my ($self, $cfg_lines) = @_;
+
+  # Flag to indicate that a declared branch revision must match with its changed
+  # revision
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('REVMATCH')} @$cfg_lines) {
+    next if ($line->slabel_fields) > 1;
+    $self->setting ([qw/EXT_REVMATCH/], $line->bvalue);
+    $line->parsed (1);
+  }
+
+  # Repository, revision and source directories
+  # ----------------------------------------------------------------------------
+  for my $name (qw/repos revision dirs expdirs/) {
+    my @lines = grep {
+      $_->slabel_starts_with_cfg (uc ($name)) or
+      $name eq 'revision' and $_->slabel_starts_with_cfg ('VERSION');
+    } @$cfg_lines;
+    for my $line (@lines) {
+      my @names = $line->slabel_fields;
+      shift @names;
+
+      # Detemine package and tag
+      my $tag     = pop @names;
+      my $pckroot = $names[0];
+      my $pck     = join ($FCM1::Config::DELIMITER, @names);
+
+      # Check that $tag and $pckroot are defined
+      next unless $tag and $pckroot;
+
+      # Check if branch already exists.
+      # If so, set $branch to point to existing branch
+      my $branch = undef;
+      for (@{ $self->branches }) {
+        next unless $_->package eq $pckroot and $_->tag eq $tag;
+
+        $branch = $_;
+        last;
+      }
+
+      # Otherwise, create a new branch
+      if (not $branch) {
+        $branch = FCM1::ReposBranch->new (PACKAGE => $pckroot, TAG => $tag,);
+
+        push @{ $self->branches }, $branch;
+      }
+
+      if ($name eq 'repos' or $name eq 'revision') {
+        # Branch location or revision
+        $branch->$name ($line->value);
+
+      } else { # $name eq 'dirs' or $name eq 'expdirs'
+        # Source directory or expandable source directory
+        if ($pck eq $pckroot and $line->value !~ m#^/#) {
+          # Sub-package name not set and source directory quoted as a relative
+          # path, determine package name from path name
+          $pck = join (
+            $FCM1::Config::DELIMITER,
+            ($pckroot, File::Spec->splitdir ($line->value)),
+          );
+        }
+
+        # A "/" is equivalent to the top (empty) package
+        my $value = ($line->value =~ m#^/+$#) ? '' : $line->value;
+        $branch->$name ($pck, $value);
+      }
+
+      $line->parsed (1);
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->expand_cfg ();
+#
+# DESCRIPTION
+#   This method expands the settings of the extract configuration.
+# ------------------------------------------------------------------------------
+
+sub expand_cfg {
+  my $self = shift;
+
+  my $rc = 1;
+  for my $use (@{ $self->inherit }) {
+    $rc = $use->expand_cfg if $rc;
+  }
+
+  return $rc unless $rc;
+
+  # Establish a set of source directories from the "base repository"
+  my %base_branches = ();
+
+  # Inherit "base" set of source directories from re-used extracts
+  for my $use (@{ $self->inherit }) {
+    my @branches = @{ $use->branches };
+
+    for my $branch (@branches) {
+      my $package              = $branch->package;
+      $base_branches{$package} = $branch unless exists $base_branches{$package};
+    }
+  }
+
+  for my $branch (@{ $self->branches }) {
+    # Expand URL keywords if necessary
+    if ($branch->repos) {
+      my $repos = FCM1::Util::tidy_url(FCM1::Keyword::expand($branch->repos()));
+      $branch->repos ($repos) if $repos ne $branch->repos;
+    }
+
+    # Check that repository type and revision are set
+    if ($branch->repos and &is_url ($branch->repos)) {
+      $branch->type ('svn') unless $branch->type;
+      $branch->revision ('head') unless $branch->revision;
+
+    } else {
+      $branch->type ('user') unless $branch->type;
+      $branch->revision ('user') unless $branch->revision;
+    }
+
+    $rc = $branch->expand_revision if $rc; # Get revision number from keywords
+    $rc = $branch->expand_path     if $rc; # Expand relative path to full path
+    $rc = $branch->expand_all      if $rc; # Search sub-directories
+    last unless $rc;
+
+    my $package = $branch->package;
+
+    if (exists $base_branches{$package}) {
+      # A base branch for this package exists
+
+      # If current branch has no source directory, use the set provided by the
+      # base branch
+      my %dirs = %{ $branch->dirs };
+      $branch->add_base_dirs ($base_branches{$package}) unless keys %dirs;
+
+    } else {
+      # This package does not yet have a base branch, set this branch as base
+      $base_branches{$package} = $branch;
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->create_dir_stack ();
+#
+# DESCRIPTION
+#   This method creates a hash of source directories to be processed. If the
+#   flag INHERITED is set to true, the source directories are assumed processed
+#   and extracted.
+# ------------------------------------------------------------------------------
+
+sub create_dir_stack {
+  my $self = shift;
+  my %args = @_;
+
+  # Inherit from USE ext cfg
+  for my $use (@{ $self->inherit }) {
+    $use->create_dir_stack () or return 0;
+    my %use_srcdirs = %{ $use->srcdirs };
+
+    while (my ($key, $value) = each %use_srcdirs) {
+      $self->srcdirs ($key, $value);
+
+      # Re-set destination to current destination
+      my @path = split (/$FCM1::Config::DELIMITER/, $key);
+      $self->srcdirs ($key)->{DEST} = File::Spec->catfile (
+        $self->dest->srcdir, @path,
+      );
+    }
+  }
+
+  # Build stack from current ext cfg
+  for my $branch (@{ $self->branches }) {
+    my %branch_dirs = %{ $branch->dirs };
+
+    for my $dir (keys %branch_dirs) {
+      # Check whether source directory is already in the list
+      if (not $self->srcdirs ($dir)) { # if not, create it
+        $self->srcdirs ($dir, {
+          DEST  => File::Spec->catfile (
+            $self->dest->srcdir, split (/$FCM1::Config::DELIMITER/, $dir)
+          ),
+          STACK => [],
+          FILES => {},
+        });
+      }
+
+      my $stack = $self->srcdirs ($dir)->{STACK}; # copy reference
+
+      # Create a new layer in the input stack
+      my $layer = FCM1::SrcDirLayer->new (
+        NAME      => $dir,
+        PACKAGE   => $branch->package,
+        TAG       => $branch->tag,
+        LOCATION  => $branch->dirs ($dir),
+        REPOSROOT => $branch->repos,
+        REVISION  => $branch->revision,
+        TYPE      => $branch->type,
+        EXTRACTED => @{ $self->inherited }
+                     ? $self->srcdirs ($dir)->{DEST} : undef,
+      );
+
+      # Check whether layer is already in the stack
+      my $exist = grep {
+        $_->location eq $layer->location and $_->revision eq $layer->revision;
+      } @{ $stack };
+
+      if (not $exist) {
+        # If not already exist, put layer into stack
+
+        # Note: user stack always comes last
+        if (! $layer->user and exists $stack->[-1] and $stack->[-1]->user) {
+          my $lastlayer = pop @{ $stack };
+          push @{ $stack }, $layer;
+          $layer = $lastlayer;
+        }
+
+        push @{ $stack }, $layer;
+
+      } elsif ($layer->user) {
+
+        # User layer already exists, overwrite it
+        $stack->[-1] = $layer;
+
+      }
+    }
+  }
+
+  # Use the cache to sort the source directory layer hash
+  return $self->compare_setting (METHOD_LIST => ['sort_dir_stack']);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, \@new_lines) = $self->sort_dir_stack ($old_lines);
+#
+# DESCRIPTION
+#   This method sorts thesource directories hash to be processed.
+# ------------------------------------------------------------------------------
+
+sub sort_dir_stack {
+  my ($self, $old_lines) = @_;
+
+  my $rc = 0;
+
+  my %old = ();
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      $old{$line->label} = $line->value;
+    }
+  }
+
+  my %new;
+
+  # Compare each layer to base layer, discard unnecessary layers
+  DIR: for my $srcdir (keys %{ $self->srcdirs }) {
+    my @stack = ();
+
+    while (my $layer = shift @{ $self->srcdirs ($srcdir)->{STACK} }) {
+      if ($layer->user) {
+        # Local file system branch, check that the declared location exists
+        if (-d $layer->location) {
+          # Local file system branch always takes precedence
+          push @stack, $layer;
+
+        } else {
+          w_report 'ERROR: ', $layer->location, ': declared source directory ',
+                   'does not exists ';
+          $rc = undef;
+          last DIR;
+        }
+
+      } else {
+        my $key = join ($FCM1::Config::DELIMITER, (
+          $srcdir, $layer->location, $layer->revision
+        ));
+
+        unless ($layer->extracted and $layer->commit) {
+          # See if commit revision information is cached
+          if (keys %old and exists $old{$key}) {
+            $layer->commit ($old{$key});
+
+          } else {
+            $layer->get_commit;
+            $rc = 1;
+          }
+
+          # Check source directory for commit revision, if necessary
+          if (not $layer->commit) {
+            w_report 'Error: cannot determine the last changed revision of ',
+                     $layer->location;
+            $rc = undef;
+            last DIR;
+          }
+
+          # Set cache directory for layer
+          my $tag_ver = $layer->tag . '__' . $layer->commit;
+          $layer->cachedir (File::Spec->catfile (
+            $self->dest->cachedir,
+            split (/$FCM1::Config::DELIMITER/, $srcdir),
+            $tag_ver,
+          ));
+        }
+
+        # New line in cache config file
+        $new{$key} = $layer->commit;
+
+        # Push this layer in the stack:
+        # 1. it has a different revision compared to the top layer
+        # 2. it is the top layer (base line code)
+        if (@stack > 0) {
+          push @stack, $layer if $layer->commit != $stack[0]->commit;
+
+        } else {
+          push @stack, $layer;
+        }
+
+      }
+    }
+
+    $self->srcdirs ($srcdir)->{STACK} = \@stack;
+  }
+
+  # Write "commit cache" file
+  my @new_lines;
+  if (defined ($rc)) {
+    for my $key (sort keys %new) {
+      push @new_lines, FCM1::CfgLine->new (label => $key, value => $new{$key});
+    }
+  }
+
+  return ($rc, \@new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->extract_src ();
+#
+# DESCRIPTION
+#   This internal method performs the extract of the source directories and
+#   files if necessary.
+# ------------------------------------------------------------------------------
+
+sub extract_src {
+  my $self = shift;
+  my $rc = 1;
+
+  # Ensure destinations exist and are directories
+  for my $srcdir (values %{ $self->srcdirs }) {
+    last if not $rc;
+    if (-f $srcdir->{DEST}) {
+      w_report $srcdir->{DEST},
+               ': destination exists and is not a directory, abort.';
+      $rc = 0;
+    }
+  }
+
+  # Retrieve previous/record current extract configuration for each file.
+  $rc = $self->compare_setting (
+    CACHEBASE => $self->setting ('CACHE_FILE_SRC'),
+    METHOD_LIST => ['compare_setting_srcfiles'],
+  ) if $rc;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, \@new_lines) = $self->compare_setting_srcfiles ($old_lines);
+#
+# DESCRIPTION
+#   For each file to be extracted, this method creates an instance of an
+#   FCM1::ExtractFile object. It then compares its file's sources to determine
+#   if they have changed. If so, it will allow the FCM1::ExtractFile to
+#   "re-extract" the file to the destination. Otherwise, it will set
+#   FCM1::ExtractFile->dest_status to a null string to denote an "unchanged"
+#   dest_status.
+#
+# SEE ALSO
+#   FCM1::ConfigSystem->compare_setting.
+# ------------------------------------------------------------------------------
+
+sub compare_setting_srcfiles {
+  my ($self, $old_lines) = @_;
+  my $rc = 1;
+
+  # Retrieve previous extract configuration for each file
+  # ----------------------------------------------------------------------------
+  my %old = ();
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      $old{$line->label} = $line->value;
+    }
+  }
+
+  # Build up a sequence using a FCM1::ExtractFile object for each file
+  # ----------------------------------------------------------------------------
+  for my $srcdir (values %{ $self->srcdirs }) {
+    my %pkgnames0; # (to be) list of package names in the base layer
+    for my $i (0 .. @{ $srcdir->{STACK} } - 1) {
+      my $layer = $srcdir->{STACK}->[$i];
+      # Update the cache for each layer of the stack if necessary
+      $layer->update_cache unless $layer->extracted or -d $layer->localdir;
+
+      # Get list of files in the cache or local directory
+      my %pkgnames;
+      for my $file (($layer->get_files)) {
+        my $pkgname = join (
+          '/', split (/$FCM1::Config::DELIMITER/, $layer->name), $file
+        );
+        $pkgnames0{$pkgname} = 1 if $i == 0; # store package name in base layer
+        $pkgnames{$pkgname} = 1; # store package name in the current layer
+        if (not $self->files ($pkgname)) {
+          $self->files ($pkgname, FCM1::ExtractFile->new (
+            conflict => $self->conflict,
+            dest     => $self->dest->srcpath,
+            pkgname  => $pkgname,
+          ));
+
+          # Base is empty
+          $self->files ($pkgname)->src->[0] = FCM1::ExtractSrc->new (
+            id      => $layer->tag,
+            pkgname => $pkgname,
+          ) if $i > 0;
+        }
+        my $cache = File::Spec->catfile ($layer->localdir, $file);
+        push @{ $self->files ($pkgname)->src }, FCM1::ExtractSrc->new (
+          cache   => $cache,
+          id      => $layer->tag,
+          pkgname => $pkgname,
+          rev     => ($layer->user ? (stat ($cache))[9] : $layer->commit),
+          uri     => join ('/', $layer->location, $file),
+        );
+      }
+
+      # List of removed files in this layer (relative to base layer)
+      if ($i > 0) {
+        for my $pkgname (keys %pkgnames0) {
+          push @{ $self->files ($pkgname)->src }, FCM1::ExtractSrc->new (
+            id      => $layer->tag,
+            pkgname => $pkgname,
+          ) if not exists $pkgnames{$pkgname}
+        }
+      }
+    }
+  }
+
+  # Compare with old settings
+  # ----------------------------------------------------------------------------
+  my %new = ();
+  for my $key (sort keys %{ $self->files }) {
+    # Set up value for cache
+    my @sources = ();
+    for my $src (@{ $self->files ($key)->src }) {
+      push @sources, (defined ($src->uri) ? ($src->uri . '@' . $src->rev) : '');
+    }
+
+    my $value = join ($FCM1::Config::DELIMITER, @sources);
+
+    # Set FCM1::ExtractFile->dest_status to "unchanged" if value is unchanged
+    if (exists($old{$key}) && $old{$key} eq $value && !grep {!$_} @sources) {
+      $self->files($key)->dest_status('');
+    }
+
+    # Write current settings
+    $new{$key} = $value;
+  }
+
+  # Delete those that exist in previous extract but not in current
+  # ----------------------------------------------------------------------------
+  for my $key (sort keys %old) {
+    next if exists $new{$key};
+    $self->files ($key, FCM1::ExtractFile->new (
+      dest    => $self->dest->srcpath,
+      pkgname => $key,
+    ));
+  }
+
+  # Extract each file, if necessary
+  # ----------------------------------------------------------------------------
+  for my $key (sort keys %{ $self->files }) {
+    $rc = $self->files ($key)->run if defined ($rc);
+    last if not defined ($rc);
+  }
+
+  # Report status
+  # ----------------------------------------------------------------------------
+  if (defined ($rc) and $self->verbose) {
+    my %src_status_count = ();
+    my %dest_status_count = ();
+    for my $key (sort keys %{ $self->files }) {
+      # Report changes in destination in verbose 1 or above
+      my $dest_status = $self->files ($key)->dest_status;
+      my $src_status = $self->files ($key)->src_status;
+      next unless $self->verbose and $dest_status;
+
+      if ($dest_status and $dest_status ne '?') {
+        if (exists $dest_status_count{$dest_status}) {
+          $dest_status_count{$dest_status}++;
+
+        } else {
+          $dest_status_count{$dest_status} = 1;
+        }
+      }
+
+      if ($src_status and $src_status ne '?') {
+        if (exists $src_status_count{$src_status}) {
+          $src_status_count{$src_status}++;
+
+        } else {
+          $src_status_count{$src_status} = 1;
+        }
+      }
+
+      # Destination status in column 1, source status in column 2
+      if ($self->verbose > 1) {
+        my @srcs = @{$self->files ($key)->src_actual};
+        print ($dest_status ? $dest_status : ' ');
+        print ($src_status ? $src_status : ' ');
+        print ' ' x 5, $key;
+        print ' (', join (', ', map {$_->id} @srcs), ')' if @srcs;
+        print "\n";
+      }
+    }
+
+    # Report number of files in each dest_status category
+    if (%dest_status_count) {
+      print 'Column 1: ' if $self->verbose > 1;
+      print 'Destination status summary:', "\n";
+      for my $key (sort keys %FCM1::ExtractFile::DEST_STATUS_CODE) {
+        next unless $key;
+        next if not exists ($dest_status_count{$key});
+        print '  No of files ';
+        print '[', $key, '] ' if $self->verbose > 1;
+        print $FCM1::ExtractFile::DEST_STATUS_CODE{$key}, ': ',
+              $dest_status_count{$key}, "\n";
+      }
+    }
+
+    # Report number of files in each dest_status category
+    if (%src_status_count) {
+      print 'Column 2: ' if $self->verbose > 1;
+      print 'Source status summary:', "\n";
+      for my $key (sort keys %FCM1::ExtractFile::SRC_STATUS_CODE) {
+        next unless $key;
+        next if not exists ($src_status_count{$key});
+        print '  No of files ';
+        print '[', $key, '] ' if $self->verbose > 1;
+        print $FCM1::ExtractFile::SRC_STATUS_CODE{$key}, ': ',
+              $src_status_count{$key}, "\n";
+      }
+    }
+  }
+
+  # Record configuration of current extract for each file
+  # ----------------------------------------------------------------------------
+  my @new_lines;
+  if (defined ($rc)) {
+    for my $key (sort keys %new) {
+      push @new_lines, FCM1::CfgLine->new (label => $key, value => $new{$key});
+    }
+  }
+
+  return ($rc, \@new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @array = $self->sort_bdeclare ();
+#
+# DESCRIPTION
+#   This method returns sorted build declarations, filtering out repeated
+#   entries, where possible.
+# ------------------------------------------------------------------------------
+
+sub sort_bdeclare {
+  my $self = shift;
+
+  # Get list of build configuration labels that can be declared multiple times
+  my %cfg_keyword = map {
+    ($self->cfglabel ($_), 1)
+  } split (/$FCM1::Config::DELIMITER_LIST/, $self->setting ('CFG_KEYWORD'));
+
+  my @bdeclares = ();
+  for my $d (reverse @{ $self->bdeclare }) {
+    # Reconstruct array from bottom up
+    # * always add declarations that can be declared multiple times
+    # * otherwise add only if it is declared below
+    unshift @bdeclares, $d
+      if exists $cfg_keyword{uc (($d->slabel_fields)[0])} or
+         not grep {$_->slabel eq $d->slabel} @bdeclares;
+  }
+
+  return (sort {$a->slabel cmp $b->slabel} @bdeclares);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines ();
+#
+# DESCRIPTION
+#   See description of FCM1::ConfigSystem->to_cfglines for further information.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines {
+  my ($self) = @_;
+
+  return (
+    FCM1::ConfigSystem::to_cfglines($self),
+
+    $self->rdest->to_cfglines (),
+    FCM1::CfgLine->new (),
+
+    @{ $self->bdeclare } ? (
+      FCM1::CfgLine::comment_block ('Build declarations'),
+      map {
+        FCM1::CfgLine->new (label => $_->label, value => $_->value)
+      } ($self->sort_bdeclare),
+      FCM1::CfgLine->new (),
+    ) : (),
+
+    FCM1::CfgLine::comment_block ('Project and branches'),
+    (map {($_->to_cfglines ())} @{ $self->branches }),
+
+    ($self->conflict ne 'merge') ? (
+      FCM1::CfgLine->new (
+        label => $self->cfglabel ('CONFLICT'), value => $self->conflict,
+      ),
+      FCM1::CfgLine->new (),
+    ) : (),
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines_bld ();
+#
+# DESCRIPTION
+#   Returns a list of configuration lines of the current extract suitable for
+#   feeding into the build system.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines_bld {
+  my ($self) = @_;
+
+  my $dest = $self->rdest->rootdir ? 'rdest' : 'dest';
+  my $root = File::Spec->catfile ('$HERE', '..');
+
+  my @inherits;
+  my @no_inherits;
+  if (@{ $self->inherit }) {
+    # List of inherited builds
+    for (@{ $self->inherit }) {
+      push @inherits, FCM1::CfgLine->new (
+        label => $self->cfglabel ('USE'), value => $_->$dest->rootdir
+      );
+    }
+
+    # List of files that should not be inherited
+    for my $key (sort keys %{ $self->files }) {
+      next unless $self->files ($key)->dest_status eq 'd';
+      my $label = join ('::', (
+        $self->cfglabel ('INHERIT'),
+        $self->cfglabel ('FILE'),
+        split (m#/#, $self->files ($key)->pkgname),
+      ));
+      push @no_inherits, FCM1::CfgLine->new (label => $label, value => 'false');
+    }
+  }
+
+  return (
+    FCM1::CfgLine::comment_block ('File header'),
+    (map
+      {my ($lbl, $val) = @{$_}; FCM1::CfgLine->new(label => $lbl, value => $val)}
+      (
+        [$self->cfglabel('CFGFILE') . $FCM1::Config::DELIMITER . 'TYPE'   , 'bld'],
+        [$self->cfglabel('CFGFILE') . $FCM1::Config::DELIMITER . 'VERSION', '1.0'],
+        [],
+      )
+    ),
+
+    @{ $self->inherit } ? (
+      @inherits,
+      @no_inherits,
+      FCM1::CfgLine->new (),
+    ) : (),
+
+    FCM1::CfgLine::comment_block ('Destination'),
+    FCM1::CfgLine->new (label => $self->cfglabel ('DEST'), value => $root),
+    FCM1::CfgLine->new (),
+
+    @{ $self->bdeclare } ? (
+      FCM1::CfgLine::comment_block ('Build declarations'),
+      map {
+        FCM1::CfgLine->new (label => $_->slabel, value => $_->value)
+      } ($self->sort_bdeclare),
+      FCM1::CfgLine->new (),
+    ) : (),
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->write_cfg ();
+#
+# DESCRIPTION
+#   This method writes the configuration file at the end of the run. It calls
+#   $self->write_cfg_system ($cfg) to write any system specific settings.
+# ------------------------------------------------------------------------------
+
+sub write_cfg {
+  my $self = shift;
+
+  my $cfg = FCM1::CfgFile->new (TYPE => $self->type);
+  $cfg->lines ([$self->to_cfglines()]);
+  $cfg->print_cfg ($self->dest->extcfg);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->write_cfg_bld ();
+#
+# DESCRIPTION
+#   This internal method writes the build configuration file.
+# ------------------------------------------------------------------------------
+
+sub write_cfg_bld {
+  my $self = shift;
+
+  my $cfg = FCM1::CfgFile->new (TYPE => 'bld');
+  $cfg->lines ([$self->to_cfglines_bld()]);
+  $cfg->print_cfg ($self->dest->bldcfg);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ExtractConfigComparator.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ExtractConfigComparator.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ExtractConfigComparator.pm	(revision 5095)
@@ -0,0 +1,371 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+################################################################################
+# A generic reporter of the comparator's result
+{
+    package Reporter;
+
+    ############################################################################
+    # Class method: Constructor
+    sub new {
+        my ($class) = @_;
+        return bless(\do{my $annon_scalar}, $class);
+    }
+
+    ############################################################################
+    # Class method: Factory for Reporter object
+    sub get_reporter {
+        my ($self, $comparator) = @_;
+        my $class = defined($comparator->get_wiki()) ? 'WikiReporter'
+                  :                                    'TextReporter'
+                  ;
+        return $class->new();
+    }
+
+    ############################################################################
+    # Reports the results
+    sub report {
+        my ($self, $comparator) = @_;
+        if (keys(%{$comparator->get_log_of()})) {
+            print("Revisions at which extract declarations are modified:\n\n");
+        }
+        $self->report_impl($comparator);
+    }
+
+    ############################################################################
+    # Does the actual reporting
+    sub report_impl {
+        my ($self, $comparator) = @_;
+    }
+}
+
+################################################################################
+# Reports the comparator's result in Trac wiki format
+{
+    package WikiReporter;
+    our @ISA = qw{Reporter};
+
+    use FCM1::CmUrl;
+    use FCM1::Keyword;
+    use FCM1::Util qw{tidy_url};
+
+    ############################################################################
+    # Reports the comparator's result
+    sub report_impl {
+        my ($self, $comparator) = @_;
+        # Output in wiki format
+        my $wiki_url = FCM1::CmUrl->new(
+            URL => tidy_url(FCM1::Keyword::expand($comparator->get_wiki()))
+        );
+        my $base_trac
+            = $comparator->get_wiki()
+            ? FCM1::Keyword::get_browser_url($wiki_url->project_url())
+            : $wiki_url;
+        if (!$base_trac) {
+            $base_trac = $wiki_url;
+        }
+
+        for my $key (sort keys(%{$comparator->get_log_of()})) {
+            my $branch_trac = FCM1::Keyword::get_browser_url($key);
+            $branch_trac =~ s{\A $base_trac (?:/*|\z)}{source:}xms;
+            print("[$branch_trac]:\n");
+            my %branch_of = %{$comparator->get_log_of()->{$key}};
+            for my $rev (sort {$b <=> $a} keys(%branch_of)) {
+                print(
+                    $branch_of{$rev}->display_svnlog($rev, $base_trac), "\n",
+                );
+            }
+            print("\n");
+        }
+    }
+}
+
+################################################################################
+# Reports the comparator's result in simple text format
+{
+    package TextReporter;
+    our @ISA = qw{Reporter};
+
+    use FCM1::Config;
+
+    my $SEPARATOR = q{-} x 80 . "\n";
+
+    ############################################################################
+    # Reports the comparator's result
+    sub report_impl {
+        my ($self, $comparator) = @_;
+        for my $key (sort keys(%{$comparator->get_log_of()})) {
+            # Output in plain text format
+            print $key, ':', "\n";
+            my %branch_of = %{$comparator->get_log_of()->{$key}};
+            if (FCM1::Config->instance()->verbose() > 1) {
+                for my $rev (sort {$b <=> $a} keys(%branch_of)) {
+                    print(
+                        $SEPARATOR, $branch_of{$rev}->display_svnlog($rev), "\n"
+                    );
+                }
+            }
+            else {
+                print(join(q{ }, sort {$b <=> $a} keys(%branch_of)), "\n");
+            }
+            print $SEPARATOR, "\n";
+        }
+    }
+}
+
+package FCM1::ExtractConfigComparator;
+
+use FCM1::CmUrl;
+use FCM1::Extract;
+
+################################################################################
+# Class method: Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Returns an array containing the 2 configuration files to compare
+sub get_files {
+    my ($self) = @_;
+    return (wantarray() ? @{$self->{files}} : $self->{files});
+}
+
+################################################################################
+# Returns the wiki link on wiki mode
+sub get_wiki {
+    my ($self) = @_;
+    return $self->{wiki};
+}
+
+################################################################################
+# Returns the result log
+sub get_log_of {
+    my ($self) = @_;
+    return (wantarray() ? %{$self->{log_of}} : $self->{log_of});
+}
+
+################################################################################
+# Invokes the comparator
+sub invoke {
+    my ($self) = @_;
+
+    # Reads the extract configurations
+    my (@cfg, $rc);
+    for my $i (0 .. 1) {
+        $cfg[$i] = FCM1::Extract->new();
+        $cfg[$i]->cfg()->src($self->get_files()->[$i]);
+        $cfg[$i]->parse_cfg();
+        $rc = $cfg[$i]->expand_cfg();
+        if (!$rc) {
+            e_report();
+        }
+    }
+
+    # Get list of URLs
+    # --------------------------------------------------------------------------
+    my @urls = ();
+    for my $i (0 .. 1) {
+        # List of branches in each extract configuration file
+        my @branches = @{$cfg[$i]->branches()};
+        BRANCH:
+        for my $branch (@branches) {
+            # Ignore declarations of local directories
+            if ($branch->type() eq 'user') {
+                next BRANCH;
+            }
+
+            # List of SRC declarations in each branch
+            my %dirs = %{$branch->dirs()};
+
+            for my $dir (values(%dirs)) {
+                # Set up a new instance of FCM1::CmUrl object for each SRC
+                my $cm_url = FCM1::CmUrl->new (
+                    URL => $dir . (
+                        $branch->revision() ? '@' . $branch->revision() : q{}
+                    ),
+                );
+
+                $urls[$i]{$cm_url->branch_url()}{$dir} = $cm_url;
+            }
+        }
+    }
+
+    # Compare
+    # --------------------------------------------------------------------------
+    $self->{log_of} = {};
+    for my $i (0 .. 1) {
+        # Compare the first file with the second one and then vice versa
+        my $j = ($i == 0) ? 1 : 0;
+
+        for my $branch (sort keys(%{$urls[$i]})) {
+            if (exists($urls[$j]{$branch})) {
+                # Same REPOS declarations in both files
+                DIR:
+                for my $dir (sort keys(%{$urls[$i]{$branch}})) {
+                    if (exists($urls[$j]{$branch}{$dir})) {
+                        if ($i == 1) {
+                            next DIR;
+                        }
+
+                        my $this_url = $urls[$i]{$branch}{$dir};
+                        my $that_url = $urls[$j]{$branch}{$dir};
+
+                        # Compare their last changed revisions
+                        my $this_rev
+                            = $this_url->svninfo(FLAG => 'commit:revision');
+                        my $that_rev
+                            = $that_url->svninfo(FLAG => 'commit:revision');
+
+                        # Make sure last changed revisions differ
+                        if ($this_rev eq $that_rev) {
+                            next DIR;
+                        }
+
+                        # Not interested in the log before the minimum revision
+                        my $min_rev
+                            = $this_url->pegrev() > $that_url->pegrev()
+                              ? $that_url->pegrev() : $this_url->pegrev();
+
+                        $this_rev = $min_rev if $this_rev < $min_rev;
+                        $that_rev = $min_rev if $that_rev < $min_rev;
+
+                        # Get list of changed revisions using the commit log
+                        my $u = ($this_rev > $that_rev) ? $this_url : $that_url;
+                        my %revs = $u->svnlog(REV => [$this_rev, $that_rev]);
+
+                        REV:
+                        for my $rev (keys %revs) {
+                            # Check if revision is already in the list
+                            if (
+                                   exists($self->{log_of}{$branch}{$rev})
+                                || $rev == $min_rev
+                            ) {
+                                next REV;
+                            }
+
+                            # Get list of changed paths. Accept this revision
+                            # only if it contains changes in the current branch
+                            my %paths  = %{$revs{$rev}{paths}};
+
+                            PATH:
+                            for my $path (keys(%paths)) {
+                                my $change_url
+                                    = FCM1::CmUrl->new(URL => $u->root() . $path);
+
+                                if ($change_url->branch() eq $u->branch()) {
+                                    $self->{log_of}{$branch}{$rev} = $u;
+                                    last PATH;
+                                }
+                            }
+                        }
+                    }
+                    else {
+                        $self->_report_added(
+                            $urls[$i]{$branch}{$dir}->url_peg(), $i, $j);
+                    }
+                }
+            }
+            else {
+                $self->_report_added($branch, $i, $j);
+            }
+        }
+    }
+
+    my $reporter = Reporter->get_reporter($self);
+    $reporter->report($self);
+    return $rc;
+}
+
+################################################################################
+# Reports added/deleted declaration
+sub _report_added {
+    my ($self, $branch, $i, $j) = @_;
+    printf(
+        "%s:\n  in    : %s\n  not in: %s\n\n",
+        $branch, $self->get_files()->[$i], $self->get_files()->[$j],
+    );
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM1::ExtractConfigComparator
+
+=head1 SYNOPSIS
+
+    use FCM1::ExtractConfigComparator;
+    my $comparator = FCM1::ExtractConfigComparator->new({files => \@files});
+    $comparator->invoke();
+
+=head1 DESCRIPTION
+
+An object of this class represents a comparator of FCM extract configuration.
+It is used to compare the VC branch declarations in 2 FCM extract configuration
+files.
+
+=head1 METHODS
+
+=over 4
+
+=item C<new({files =E<gt> \@files, wiki =E<gt> $wiki})>
+
+Constructor.
+
+=item get_files()
+
+Returns an array containing the 2 configuration files to compare.
+
+=item get_wiki()
+
+Returns the wiki link on wiki mode.
+
+=item invoke()
+
+Invokes the comparator.
+
+=back
+
+=head1 TO DO
+
+More documentation.
+
+Improve the parser for extract configuration.
+
+Separate the comparator with the reporters.
+
+Add reporter to display HTML.
+
+More unit tests.
+
+=head1 SEE ALSO
+
+L<FCM1::Extract|FCM1::Extract>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ExtractFile.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ExtractFile.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ExtractFile.pm	(revision 5095)
@@ -0,0 +1,423 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::ExtractFile
+#
+# DESCRIPTION
+#   Select/combine a file in different branches and extract it to destination.
+#
+# ------------------------------------------------------------------------------
+
+use warnings;
+use strict;
+
+package FCM1::ExtractFile;
+use base qw{FCM1::Base};
+
+use FCM1::Util      qw{run_command w_report};
+use File::Basename qw{dirname};
+use File::Compare  qw{compare};
+use File::Copy     qw{copy};
+use File::Path     qw{mkpath};
+use File::Spec;
+use File::Temp     qw(tempfile);
+
+# List of property methods for this class
+my @scalar_properties = (
+  'conflict',    # conflict mode
+  'dest',        # search path to destination file
+  'dest_status', # destination status, see below
+  'pkgname',     # package name of this file
+  'src',         # list of FCM1::ExtractSrc, specified for this file
+  'src_actual',  # list of FCM1::ExtractSrc, actually used by this file
+  'src_status',  # source status, see below
+);
+
+# Status code definition for $self->dest_status
+our %DEST_STATUS_CODE = (
+  ''  => 'unchanged',
+  'M' => 'modified',
+  'A' => 'added',
+  'a' => 'added, overridding inherited',
+  'D' => 'deleted',
+  'd' => 'deleted, overridding inherited',
+  '?' => 'irrelevant',
+);
+
+# Status code definition for $self->src_status
+our %SRC_STATUS_CODE = (
+  'A' => 'added by a branch',
+  'B' => 'from the base',
+  'D' => 'deleted by a branch',
+  'M' => 'modified by a branch',
+  'G' => 'merged from 2+ branches',
+  'O' => 'overridden by a branch',
+  '?' => 'irrelevant',
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::ExtractFile->new ();
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::ExtractFile class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = FCM1::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{$_} ? $args{$_} : undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'conflict') {
+        $self->{$name} = 'merge'; # default to "merge" mode
+
+      } elsif ($name eq 'dest' or $name eq 'src' or $name eq 'src_actual') {
+        $self->{$name} = [];      # default to an empty list
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->run();
+#
+# DESCRIPTION
+#   This method runs only if $self->dest_status is not defined. It updates the
+#   destination according to the source in the list and the conflict mode
+#   setting. It updates the file in $self->dest as appropriate and sets
+#   $self->dest_status. (See above.) This method returns true on success.
+# ------------------------------------------------------------------------------
+
+sub run {
+  my ($self) = @_;
+  my $rc = 1;
+
+  if (not defined ($self->dest_status)) {
+    # Assume file unchanged
+    $self->dest_status ('');
+
+    if (@{ $self->src }) {
+      my $used;
+      # Determine or set up a file for comparing with the destination
+      ($rc, $used) = $self->run_get_used();
+
+      # Attempt to compare the destination with $used. Update on change.
+      if ($rc) {
+        $rc = defined ($used) ? $self->run_update($used) : $self->run_delete();
+      }
+
+    } else {
+      # No source, delete file in destination
+      $self->src_status ('?');
+      $rc = $self->run_delete();
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->run_delete();
+#
+# DESCRIPTION
+#   This method is part of run(). It detects this file in the destination path.
+#   If this file is in the current destination, it attempts to delete it and
+#   sets the dest_status to "D". If this file is in an inherited destination,
+#   it sets the dest_status to "d".
+# ------------------------------------------------------------------------------
+
+sub run_delete {
+  my ($self) = @_;
+
+  my $rc = 1;
+
+  $self->dest_status ('?');
+  for my $i (0 .. @{ $self->dest } - 1) {
+    my $dest = File::Spec->catfile ($self->dest->[$i], $self->pkgname);
+    next unless -f $dest;
+    if ($i == 0) {
+      $rc = unlink $dest;
+      $self->dest_status ('D');
+
+    } else {
+      $self->dest_status ('d');
+      last;
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $used) = $obj->run_get_used();
+#
+# DESCRIPTION
+#   This method is part of run(). It attempts to work out or set up the $used
+#   file. ($used is undef if it is not defined in a branch for this file.)
+# ------------------------------------------------------------------------------
+
+sub run_get_used {
+  my ($self) = @_;
+  my $rc = 1;
+  my $used;
+
+  my @sources = ($self->src->[0]);
+  my $src_status = 'B';
+  if (defined ($self->src->[0]->cache)) {
+    # File exists in base branch
+    for my $i (1 .. @{ $self->src } - 1) {
+      if (defined ($self->src->[$i]->cache)) {
+        # Detect changes in this file between base branch and branch $i
+        push @sources, $self->src->[$i]
+          if &compare ($self->src->[0]->cache, $self->src->[$i]->cache);
+
+      } else {
+        # File deleted in branch $i
+        @sources = ($self->src->[$i]);
+        last unless $self->conflict eq 'override';
+      }
+    }
+
+    if ($rc) {
+      if (@sources > 2) {
+        if ($self->conflict eq 'fail') {
+          # On conflict, fail in fail mode
+          w_report 'ERROR: ', $self->pkgname,
+                   ': modified in 2+ branches in fail conflict mode.';
+          $rc = undef;
+
+        } elsif ($self->conflict eq 'override') {
+          $used = $sources[-1]->cache;
+          $src_status = 'O';
+
+        } else {
+          # On conflict, attempt to merge in merge mode
+          ($rc, $used) = $self->run_get_used_by_merge (@sources);
+          $src_status = 'G' if $rc;
+        }
+
+      } else {
+        # 0 or 1 change, use last source
+        if (defined $sources[-1]->cache) {
+          $used = $sources[-1]->cache;
+          $src_status = 'M' if @sources > 1;
+
+        } else {
+          $src_status = 'D';
+        }
+      }
+    }
+
+  } else {
+    # File does not exist in base branch
+    @sources = ($self->src->[-1]);
+    $used = $self->src->[1]->cache;
+    $src_status = (defined ($used) ? 'A' : 'D');
+    if ($self->conflict ne 'override' and defined ($used)) {
+      for my $i (1 - @{ $self->src } .. -2) {
+        # Allow this only if files are the same in all branches
+        my $file = $self->src->[$i]->cache;
+        if ((not defined ($file)) or &compare ($used, $file)) {
+          w_report 'ERROR: ', $self->pkgname, ': cannot merge:',
+                   ' not found in base branch,',
+                   ' but differs in subsequent branches.';
+          $rc = undef;
+          last;
+
+        } else {
+          unshift @sources, $self->src->[$i];
+        }
+      }
+    }
+  }
+
+  $self->src_status ($src_status);
+  $self->src_actual (\@sources);
+
+  return ($rc, $used);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $used) = $obj->run_get_used_by_merge(@soruces);
+#
+# DESCRIPTION
+#   This method is part of run_get_used(). It attempts to merge the files in
+#   @sources and return a temporary file $used. @sources should be an array of
+#   FCM1::ExtractSrc objects. On success, $rc will be set to true.
+# ------------------------------------------------------------------------------
+
+sub run_get_used_by_merge {
+  my ($self, @sources) = @_;
+  my $rc = 1;
+
+  # Get temporary file
+  my ($fh, $used) = &tempfile ('fcm.ext.merge.XXXXXX', UNLINK => 1);
+  close $fh or die $used, ': cannot close';
+
+  for my $i (2 .. @sources - 1) {
+    # Invoke the diff3 command to merge
+    my $mine = ($i == 2 ? $sources[1]->cache : $used);
+    my $older = $sources[0]->cache;
+    my $yours = $sources[$i]->cache;
+    my @command = (
+      $self->setting (qw/TOOL DIFF3/),
+      split (/\s+/, $self->setting (qw/TOOL DIFF3FLAGS/)),
+      $mine, $older, $yours,
+    );
+    my $code;
+    my @out = &run_command (
+      \@command,
+      METHOD => 'qx',
+      ERROR  => 'ignore',
+      PRINT  => $self->verbose > 1,
+      RC     => \$code,
+      TIME   => $self->verbose > 2,
+    );
+
+    if ($code) {
+      # Failure, report and return
+      my $m = ($code == 1)
+              ? 'cannot resolve conflicts:'
+              : $self->setting (qw/TOOL DIFF3/) . 'command failed';
+      w_report 'ERROR: ', $self->pkgname, ': merge - ', $m;
+      if ($code == 1 and $self->verbose) {
+        for (0 .. $i) {
+          my $src = $sources[$_]->uri eq $sources[$_]->cache
+                    ? $sources[$_]->cache
+                    : ($sources[$_]->uri . '@' . $sources[$_]->rev);
+          w_report '  source[', $_, ']=', $src;
+        }
+
+        for (0 .. $i) {
+          w_report '  cache', $_, '=', $sources[$_]->cache;
+        }
+
+        w_report @out if $self->verbose > 2;
+      }
+      $rc = undef;
+      last;
+
+    } else {
+      # Success, write result to temporary file
+      open FILE, '>', $used or die $used, ': cannot open (', $!, ')';
+      print FILE @out;
+      close FILE or die $used, ': cannot close (', $!, ')';
+
+      # File permission, use most permissive combination of $mine and $yours
+      my $perm = ((stat($mine))[2] & 07777) | ((stat($yours))[2] & 07777);
+      chmod ($perm, $used);
+    }
+  }
+
+  return ($rc, $used);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->run_update($used_file);
+#
+# DESCRIPTION
+#   This method is part of run(). It compares the $used_file with the one in
+#   the destination. If the file does not exist in the destination or if its
+#   content is out of date, the destination is updated with the content in the
+#   $used_file. Returns true on success.
+# ------------------------------------------------------------------------------
+
+sub run_update {
+  my ($self, $used_file) = @_;
+  my ($is_diff, $is_diff_in_perms, $is_in_prev, $rc) = (1, 1, undef, 1);
+
+  # Compare with the previous version if it exists
+  DEST:
+  for my $i (0 .. @{$self->dest()} - 1) {
+    my $prev_file = File::Spec->catfile($self->dest()->[$i], $self->pkgname());
+    if (-f $prev_file) {
+      $is_in_prev = $i;
+      $is_diff = compare($used_file, $prev_file);
+      $is_diff_in_perms = (stat($used_file))[2] != (stat($prev_file))[2];
+      last DEST;
+    }
+  }
+  if (!$is_diff && !$is_diff_in_perms) {
+    return $rc;
+  }
+
+  # Update destination
+  my $dest_file = File::Spec->catfile($self->dest()->[0], $self->pkgname());
+  if ($is_diff) {
+    my $dir = dirname($dest_file);
+    if (!-d $dir) {
+      mkpath($dir);
+    }
+    $rc = copy($used_file, $dest_file);
+  }
+  $rc &&= chmod((stat($used_file))[2] & oct(7777), $dest_file);
+  if ($rc) {
+    $self->dest_status(
+        $is_in_prev          ? 'a'
+      : defined($is_in_prev) ? 'M'
+      :                        'A'
+    );
+  }
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ExtractSrc.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ExtractSrc.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ExtractSrc.pm	(revision 5095)
@@ -0,0 +1,100 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::ExtractSrc
+#
+# DESCRIPTION
+#   This class is used by the extract system to define the functionalities of a
+#   source file (or directory) in a branch.
+#
+# ------------------------------------------------------------------------------
+
+package FCM1::ExtractSrc;
+@ISA = qw(FCM1::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# FCM component modules
+use FCM1::Base;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+  'cache',   # location of the cache of this file in the current extract
+  'id',      # short ID of the branch where this file is from
+  'ignore',  # if set to true, ignore this file from this source
+  'pkgname', # package name of this file
+  'rev',     # last changed revision/timestamp of this file
+  'uri',     # URL/source path of this file
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::ExtractSrc->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::ExtractSrc class. See
+#   @scalar_properties above for allowed list of properties in the constructor.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = FCM1::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{$_} ? $args{$_} : undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Interactive.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Interactive.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Interactive.pm	(revision 5095)
@@ -0,0 +1,144 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package FCM1::Interactive;
+use base qw{Exporter};
+
+our @EXPORT_OK = qw{get_input};
+
+use FCM1::Util::ClassLoader;
+
+my $DEFAULT_IMPL_CLASS = 'FCM1::Interactive::InputGetter::CLI';
+my %DEFAULT_IMPL_CLASS_OPTIONS = ();
+
+my $IMPL_CLASS = $DEFAULT_IMPL_CLASS;
+my %IMPL_CLASS_OPTIONS = %DEFAULT_IMPL_CLASS_OPTIONS;
+
+################################################################################
+# Returns the name of the current class/settings for getting input
+sub get_impl {
+    return (wantarray() ? ($IMPL_CLASS, \%IMPL_CLASS_OPTIONS) : $IMPL_CLASS);
+}
+
+################################################################################
+# Returns the name of the current class/settings for getting input
+sub get_default_impl {
+    return (
+        wantarray()
+        ? ($DEFAULT_IMPL_CLASS, \%DEFAULT_IMPL_CLASS_OPTIONS)
+        : $DEFAULT_IMPL_CLASS
+    );
+}
+
+################################################################################
+# Sets the name of the class/settings for getting input
+sub set_impl {
+    my ($impl_class, $impl_class_options_ref) = @_;
+    if ($impl_class) {
+        $IMPL_CLASS = $impl_class;
+        if ($impl_class_options_ref) {
+            %IMPL_CLASS_OPTIONS = (%{$impl_class_options_ref});
+        }
+        else {
+            %IMPL_CLASS_OPTIONS = ();
+        }
+    }
+}
+
+################################################################################
+# Gets an input from the user and returns it
+sub get_input {
+    my (%options) = @_;
+    my ($class_name, $class_options_ref) = get_impl();
+    FCM1::Util::ClassLoader::load($class_name);
+    %options = map {lc($_), $options{$_}} keys(%options);
+    return $class_name->new({%{$class_options_ref}, %options})->invoke();
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM1::Interactive
+
+=head1 SYNOPSIS
+
+    use FCM1::Interactive;
+    FCM1::Interactive::set_impl('My::InputGetter', {option1 => 'value1', ...});
+    $answer = FCM1::Interactive::get_input(
+        title   => 'My title',
+        message => 'Would you like to ...?',
+        type    => 'yn',
+        default => 'n',
+    );
+
+=head1 DESCRIPTION
+
+Common interface for getting an interactive user reply. The default is to use a
+L<FCM1::Interactive::InputGetter::CLI|FCM1::Interactive::InputGetter::CLI> object
+with no extra options.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item get_impl()
+
+Returns the class that implements the function for get_input(%options). In
+scalar context, returns the class name only. In list context, returns the class
+name and the extra hash options that would be passed to its constructor.
+
+=item get_default_impl()
+
+Returns the defaut values for get_impl().
+
+=item set_impl($impl_class,$impl_class_options_ref)
+
+Sets the class that implements the function for get_input(%options). The name
+of the class is given in $impl_class. Any extra options that should be given to
+the constructor should be set in the hash reference $impl_class_options_ref.
+
+=item get_input(%options)
+
+Calls the appropriate function to get an input string from the user, and
+returns it.
+
+Input options are: I<title>, for a short title of the prompt, I<message>, for
+the message prompt, I<type> for the prompt type, and I<default> for the default
+value of the return value.
+
+Prompt type can be YN (yes or no), YNA (yes, no or all) or input (for an input
+string).
+
+=back
+
+=head1 SEE ALSO
+
+L<FCM1::Interactive::InputGetter|FCM1::Interactive::InputGetter>,
+L<FCM1::Interactive::InputGetter::CLI|FCM1::Interactive::InputGetter::CLI>,
+L<FCM1::Interactive::InputGetter::GUI|FCM1::Interactive::InputGetter::GUI>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Interactive/InputGetter.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Interactive/InputGetter.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Interactive/InputGetter.pm	(revision 5095)
@@ -0,0 +1,135 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package FCM1::Interactive::InputGetter;
+
+use Carp qw{croak};
+
+################################################################################
+# Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Methods: get_*
+for my $key (
+    ############################################################################
+    # Returns the title of the prompt
+    'title',
+    ############################################################################
+    # Returns the message of the prompt
+    'message',
+    ############################################################################
+    # Returns the of the prompt
+    'type',
+    ############################################################################
+    # Returns the default return value
+    'default',
+) {
+    no strict qw{refs};
+    my $getter = "get_$key";
+    *$getter = sub {
+        my ($self) = @_;
+        return $self->{$key};
+    }
+}
+
+################################################################################
+# Invokes the getter
+sub invoke {
+    my ($self) = @_;
+    croak("FCM1::Interactive::InputGetter->invoke() not implemented.");
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM1::Interactive::TxtInputGetter
+
+=head1 SYNOPSIS
+
+    use FCM1::Interactive::TxtInputGetter;
+    $answer = FCM1::Interactive::get_input(
+        title   => 'My title',
+        message => 'Would you like to ...?',
+        type    => 'yn',
+        default => 'n',
+    );
+
+=head1 DESCRIPTION
+
+An object of this abstract class is used by
+L<FCM1::Interactive|FCM1::Interactive> to get a user reply.
+
+=head1 METHODS
+
+=over 4
+
+=item new($args_ref)
+
+Constructor, normally invoked via L<FCM1::Interactive|FCM1::Interactive>.
+
+Input options are: I<title>, for a short title of the prompt, I<message>, for
+the message prompt, I<type> for the prompt type, and I<default> for the default
+value of the return value.
+
+Prompt type can be YN (yes or no), YNA (yes, no or all) or input (for an input
+string).
+
+=item get_title()
+
+Returns the title of the prompt.
+
+=item get_message()
+
+Returns the message of the prompt.
+
+=item get_type()
+
+Returns the type of the prompt, can be YN (yes or no), YNA (yes, no or all) or
+input (for an input string).
+
+=item get_default()
+
+Returns the default return value of invoke().
+
+=item invoke()
+
+Gets an input string from the user, and returns it. Sub-classes must override
+this method.
+
+=back
+
+=head1 SEE ALSO
+
+L<FCM1::Interactive|FCM1::Interactive>,
+L<FCM1::Interactive::TxtInputGetter|FCM1::Interactive::TxtInputGetter>,
+L<FCM1::Interactive::GUIInputGetter|FCM1::Interactive::GUIInputGetter>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Interactive/InputGetter/CLI.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Interactive/InputGetter/CLI.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Interactive/InputGetter/CLI.pm	(revision 5095)
@@ -0,0 +1,100 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package FCM1::Interactive::InputGetter::CLI;
+use base qw{FCM1::Interactive::InputGetter};
+
+my $DEF_MSG = q{ (or just press <return> for "%s")};
+my %EXTRA_MSG_FOR = (
+    yn  => qq{\nEnter "y" or "n"},
+    yna => qq{\nEnter "y", "n" or "a"},
+);
+my %CHECKER_FOR = (
+    yn  => sub {$_[0] eq 'y' || $_[0] eq 'n'},
+    yna => sub {$_[0] eq 'y' || $_[0] eq 'n' || $_[0] eq 'a'},
+);
+
+sub invoke {
+    my ($self) = @_;
+    my $type = $self->get_type() ? lc($self->get_type()) : q{};
+    my $message
+        = $self->get_message()
+        . (exists($EXTRA_MSG_FOR{$type}) ? $EXTRA_MSG_FOR{$type} : q{})
+        . ($self->get_default() ? sprintf($DEF_MSG, $self->get_default()) : q{})
+        . q{: }
+        ;
+    while (1) {
+        print($message);
+        my $answer = readline(STDIN);
+        chomp($answer);
+        if (!$answer && $self->get_default()) {
+            $answer = $self->get_default();
+        }
+        if (!exists($CHECKER_FOR{$type}) || $CHECKER_FOR{$type}->($answer)) {
+            return $answer;
+        }
+    }
+    return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM1::Interactive::InputGetter::CLI
+
+=head1 SYNOPSIS
+
+    use FCM1::Interactive;
+    $answer = FCM1::Interactive::get_input(
+        title   => 'My title',
+        message => 'Would you like to ...?',
+        type    => 'yn',
+        default => 'n',
+    );
+
+=head1 DESCRIPTION
+
+This is a solid implementation of
+L<FCM1::Interactive::InputGetter|FCM1::Interactive::InputGetter>. It gets a user
+reply from STDIN using a prompt on STDOUT.
+
+=head1 METHODS
+
+See L<FCM1::Interactive::InputGetter|FCM1::Interactive::InputGetter> for a list of
+methods.
+
+=head1 TO DO
+
+Use IO::Prompt.
+
+=head1 SEE ALSO
+
+L<FCM1::Interactive|FCM1::Interactive>,
+L<FCM1::Interactive::InputGetter|FCM1::Interactive::InputGetter>,
+L<FCM1::Interactive::InputGetter::GUI|FCM1::Interactive::InputGetter::GUI>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Interactive/InputGetter/GUI.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Interactive/InputGetter/GUI.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Interactive/InputGetter/GUI.pm	(revision 5095)
@@ -0,0 +1,261 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package FCM1::Interactive::InputGetter::GUI;
+use base qw{FCM1::Interactive::InputGetter};
+
+use Tk;
+
+################################################################################
+# Returns the geometry string for the pop up message box
+sub get_geometry {
+    my ($self) = @_;
+    return $self->{geometry};
+}
+
+################################################################################
+# Invokes the getter
+sub invoke {
+    my ($self) = @_;
+    my $answer;
+    local $| = 1;
+
+    # Create a main window
+    my $mw = MainWindow->new();
+    $mw->title($self->get_title());
+
+    # Define the default which applies if the dialog box is just closed or
+    # the user selects 'cancel'
+    $answer = $self->get_default() ? $self->get_default() : q{};
+
+    if (defined($self->get_type()) && $self->get_type() =~ qr{\A yn}ixms) {
+        # Create a yes-no(-all) dialog box
+
+        # If TYPE is YNA then add a third button: 'all'
+        my $buttons = $self->get_type() =~ qr{a \z}ixms ? 3 : 2;
+
+        # Message of the dialog box
+        $mw->Label('-text' => $self->get_message())->grid(
+            '-row'        => 0,
+            '-column'     => 0,
+            '-columnspan' => $buttons,
+            '-padx'       => 10,
+            '-pady'       => 10,
+        );
+
+        # The "yes" button
+        my $y_b = $mw->Button(
+            '-text'      => 'Yes',
+            '-underline' => 0,
+            '-command'   => sub {$answer = 'y'; $mw->destroy()},
+        )
+        ->grid('-row' => 1, '-column' => 0, '-padx' => 5, '-pady' => 5);
+
+        # The "no" button
+        my $n_b = $mw->Button (
+            '-text'      => 'No',
+            '-underline' => 0,
+            '-command'   => sub {$answer = 'n'; $mw->destroy()},
+        )
+        ->grid('-row' => 1, '-column' => 1, '-padx' => 5, '-pady' => 5);
+
+        # The "all" button
+        my $a_b;
+        if ($buttons == 3) {
+            $a_b = $mw->Button(
+                '-text'      => 'All',
+                '-underline' => 0,
+                '-command'   => sub {$answer = 'a'; $mw->destroy()},
+            )
+            ->grid('-row' => 1, '-column' => 2, '-padx' => 5, '-pady' => 5);
+        }
+
+        # Keyboard binding
+        if ($buttons == 3) {
+            $mw->bind('<Key>' => sub {
+                my $button
+                    = $Tk::event->K() eq 'Y' || $Tk::event->K() eq 'y' ? $y_b
+                    : $Tk::event->K() eq 'N' || $Tk::event->K() eq 'n' ? $n_b
+                    : $Tk::event->K() eq 'A' || $Tk::event->K() eq 'a' ? $a_b
+                    :                                                    undef
+                    ;
+                if (defined($button)) {
+                    $button->invoke();
+                }
+            });
+        }
+        else {
+            $mw->bind('<Key>' => sub {
+                my $button
+                    = $Tk::event->K() eq 'Y' || $Tk::event->K() eq 'y' ? $y_b
+                    : $Tk::event->K() eq 'N' || $Tk::event->K() eq 'n' ? $n_b
+                    :                                                    undef
+                    ;
+                if (defined($button)) {
+                    $button->invoke();
+                }
+            });
+        }
+
+        # Handle the situation when the user attempts to quit the window
+        $mw->protocol('WM_DELETE_WINDOW', sub {
+            if (self->get_default()) {
+                $answer = $self->get_default();
+            }
+            $mw->destroy();
+        });
+    }
+    else {
+        # Create a dialog box to obtain an input string
+        # Message of the dialog box
+        $mw->Label('-text' => $self->get_message())->grid(
+            '-row'    => 0,
+            '-column' => 0,
+            '-padx'   => 5,
+            '-pady'   => 5,
+        );
+
+        # Entry box for the user to type in the input string
+        my $entry   = $answer;
+        my $input_e = $mw->Entry(
+            '-textvariable' => \$entry,
+            '-width'        => 40,
+        )
+        ->grid(
+            '-row'    => 0,
+            '-column' => 1,
+            '-sticky' => 'ew',
+            '-padx'   => 5,
+            '-pady'   => 5,
+        );
+
+        my $b_f = $mw->Frame->grid(
+            '-row'        => 1,
+            '-column'     => 0,
+            '-columnspan' => 2,
+            '-sticky'     => 'e',
+        );
+
+        # An OK button to accept the input string
+        my $ok_b = $b_f->Button (
+            '-text' => 'OK',
+            '-command' => sub {$answer = $entry; $mw->destroy()},
+        )
+        ->grid('-row' => 0, '-column' => 0, '-padx' => 5, '-pady' => 5);
+
+        # A Cancel button to reject the input string
+        my $cancel_b = $b_f->Button(
+            '-text' => 'Cancel',
+            '-command' => sub {$answer = undef; $mw->destroy()},
+        )
+        ->grid('-row' => 0, '-column' => 1, '-padx' => 5, '-pady' => 5);
+
+        # Keyboard binding
+        $mw->bind ('<Key>' => sub {
+            if ($Tk::event->K eq 'Return' or $Tk::event->K eq 'KP_Enter') {
+                $ok_b->invoke();
+            }
+            elsif ($Tk::event->K eq 'Escape') {
+                $cancel_b->invoke();
+            }
+        });
+
+        # Allow the entry box to expand
+        $mw->gridColumnconfigure(1, '-weight' => 1);
+
+        # Set initial focus on the entry box
+        $input_e->focus();
+        $input_e->icursor('end');
+    }
+
+    $mw->geometry($self->get_geometry());
+
+    # Switch on "always on top" property for $mw
+    $mw->property(
+        qw/set _NET_WM_STATE ATOM/,
+        32,
+        ['_NET_WM_STATE_STAYS_ON_TOP'],
+        ($mw->toplevel()->wrapper())[0],
+    );
+
+    MainLoop();
+    return $answer;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM1::Interactive::InputGetter::GUI
+
+=head1 SYNOPSIS
+
+    use FCM1::Interactive;
+    $answer = FCM1::Interactive::get_input(
+        title   => 'My title',
+        message => 'Would you like to ...?',
+        type    => 'yn',
+        default => 'n',
+    );
+
+=head1 DESCRIPTION
+
+This is a solid implementation of
+L<FCM1::Interactive::InputGetter|FCM1::Interactive::InputGetter>. It gets a user
+reply from a TK pop up message box.
+
+=head1 METHODS
+
+See L<FCM1::Interactive::InputGetter|FCM1::Interactive::InputGetter> for a list of
+inherited methods.
+
+=over 4
+
+=item new($args_ref)
+
+As in L<FCM1::Interactive::InputGetter|FCM1::Interactive::InputGetter>, but also
+accept a I<geometry> element for setting the geometry string of the pop up
+message box.
+
+=item get_geometry()
+
+Returns the geometry string for the pop up message box.
+
+=back
+
+=head1 TO DO
+
+Tidy up the logic of invoke(). Separate the logic for YN/A box and string input
+box, probably using a strategy pattern. Factor out the logic for the display
+and the return value.
+
+=head1 SEE ALSO
+
+L<FCM1::Interactive|FCM1::Interactive>,
+L<FCM1::Interactive::InputGetter|FCM1::Interactive::InputGetter>,
+L<FCM1::Interactive::InputGetter::CLI|FCM1::Interactive::InputGetter::CLI>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Keyword.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Keyword.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Keyword.pm	(revision 5095)
@@ -0,0 +1,175 @@
+#-------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+#-------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package FCM1::Keyword;
+
+use FCM::Context::Locator;
+
+# Returns/Sets the FCM 2 utility functional object.
+{   my $UTIL;
+    sub get_util {
+        $UTIL;
+    }
+    sub set_util {
+        $UTIL = $_[0];
+    }
+}
+
+# Expands (the keywords in) the specfied location (and REV), and returns them
+sub expand {
+    my ($in_loc, $in_rev) = @_;
+    my $target = $in_rev ? $in_loc . '@' . $in_rev : $in_loc;
+    my $locator = FCM::Context::Locator->new($target);
+    _unparse_loc(get_util()->loc_as_normalised($locator), $in_rev);
+}
+
+# Returns the corresponding browser URL for the input VC location
+sub get_browser_url {
+    my ($in_loc, $in_rev) = @_;
+    my $target = $in_rev ? $in_loc . '@' . $in_rev : $in_loc;
+    my $locator = FCM::Context::Locator->new($target);
+    get_util()->loc_browser_url($locator);
+}
+
+# Un-expands the specfied location (and REV) to keywords, and returns them
+sub unexpand {
+    my ($in_loc, $in_rev) = @_;
+    my $target = $in_rev ? $in_loc . '@' . $in_rev : $in_loc;
+    my $locator = FCM::Context::Locator->new($target);
+    _unparse_loc(get_util()->loc_as_keyword($locator), $in_rev);
+}
+
+# If $in_rev, returns (LOC, REV). Otherwise, returns LOC@REV
+sub _unparse_loc {
+    my ($loc, $in_rev) = @_;
+    if (!$loc) {
+        return;
+    }
+    if ($in_rev) {
+        my ($l, $r) = $loc =~ qr{\A (.*?) @([^@]+) \z}msx;
+        if ($l && $r) {
+            return ($l, $r);
+        }
+    }
+    return $loc;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM1::Keyword
+
+=head1 SYNOPSIS
+
+    use FCM1::Keyword;
+
+    $loc = FCM1::Keyword::expand('fcm:namespace/path@rev-keyword');
+    $loc = FCM1::Keyword::unexpand('svn://host/namespace/path@1234');
+
+    ($loc, $rev) = FCM1::Keyword::expand('fcm:namespace/path', 'rev-keyword');
+    ($loc, $rev) = FCM1::Keyword::unexpand('svn://host/namespace/path', 1234);
+
+    $loc = FCM1::Keyword::get_browser_url('fcm:namespace/path');
+    $loc = FCM1::Keyword::get_browser_url('svn://host/namespace/path');
+
+    $loc = FCM1::Keyword::get_browser_url('fcm:namespace/path@1234');
+    $loc = FCM1::Keyword::get_browser_url('svn://host/namespace/path@1234');
+
+    $loc = FCM1::Keyword::get_browser_url('fcm:namespace/path', 1234);
+    $loc = FCM1::Keyword::get_browser_url('svn://host/namespace/path', 1234);
+
+=head1 DESCRIPTION
+
+Provides a compatibility layer for code in FCM1::* name space by wrapping the
+keyword related functions in L<FCM::Util|FCM::Util>. An instance of
+L<FCM::Util|FCM::Util> must be set via the set_util($value) function before
+using the other functions.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item expand($loc)
+
+Expands FCM keywords in $loc and returns the result.
+
+If $loc is a I<fcm> scheme URI, the leading part (before any "/" or "@"
+characters) of the URI opaque is the namespace of a FCM location keyword. This
+is expanded into the actual value. Optionally, $loc can be suffixed with a peg
+revision (an "@" followed by any characters). If a peg revision is a FCM
+revision keyword, it is expanded into the actual revision.
+
+=item expand($loc,$rev)
+
+Same as C<expand($loc)>, but $loc should not contain a peg revision. Returns a
+list containing the expanded version of $loc and $rev.
+
+=item get_browser_url($loc)
+
+Given a repository $loc in a known keyword namespace, returns the corresponding
+URL for the code browser.
+
+Optionally, $loc can be suffixed with a peg revision (an "@" followed by any
+characters).
+
+=item get_browser_url($loc,$rev)
+
+Same as get_browser_url($loc), but the revision should be specified using $rev
+but not pegged with $loc.
+
+=item get_util()
+
+Returns the L<FCM::Util|FCM::Util> instance (set by set_util($value)).
+
+=item set_util($value)
+
+Sets the L<FCM::Util|FCM::Util> instance.
+
+=item unexpand($loc)
+
+Does the opposite of expand($loc). Returns the FCM location keyword equivalence
+of $loc. If the $loc can be mapped using 2 or more namespaces, the namespace
+that results in the longest substitution is used. Optionally, $loc can be
+suffixed with a peg revision (an "@" followed by any characters). If a peg
+revision is a known revision, it is turned into its corresponding revision
+keyword.
+
+=item unexpand($loc,$rev)
+
+Same as unexpand($loc), but $loc should not contain a peg revision. Returns a
+list containing the unexpanded version of $loc and $rev 
+
+=item 
+
+=back
+
+=head1 SEE ALSO
+
+L<FCM::System|FCM::System>,
+L<FCM::Util|FCM::Util>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ReposBranch.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ReposBranch.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/ReposBranch.pm	(revision 5095)
@@ -0,0 +1,528 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::ReposBranch
+#
+# DESCRIPTION
+#   This class contains methods for gathering information for a repository
+#   branch. It currently supports Subversion repository and local user
+#   directory.
+#
+# ------------------------------------------------------------------------------
+
+use warnings;
+use strict;
+
+package FCM1::ReposBranch;
+use base qw{FCM1::Base};
+
+use FCM1::CfgLine;
+use FCM1::Keyword;
+use FCM1::Util      qw{expand_tilde is_url run_command w_report};
+use File::Basename qw{dirname};
+use File::Find     qw{find};
+use File::Spec;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+  'package',  # package name of which this repository belongs
+  'repos',    # repository branch root URL/path
+  'revision', # the revision of this branch
+  'tag',      # "tag" name of this branch of the repository
+  'type',     # repository type
+);
+
+# List of hash property methods for this class
+my @hash_properties = (
+  'dirs',    # list of non-recursive directories in this branch
+  'expdirs', # list of recursive directories in this branch
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::ReposBranch->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::ReposBranch class. See
+#   @scalar_properties above for allowed list of properties in the constructor.
+#   (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = FCM1::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+  }
+
+  $self->{$_} = {} for (@hash_properties);
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @hash_properties.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (@hash_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    $self->{$name} = {} if not defined ($self->{$name});
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->expand_revision;
+#
+# DESCRIPTION
+#   This method expands the revision keywords of the current branch to a
+#   revision number. It returns true on success.
+# ------------------------------------------------------------------------------
+
+sub expand_revision {
+  my $self = shift;
+
+  my $rc = 1;
+  if ($self->type eq 'svn') {
+    # Expand revision keyword
+    my $rev = (FCM1::Keyword::expand($self->repos(), $self->revision()))[1];
+
+    # Get last changed revision of the specified revision
+    my $info_ref = $self->_svn_info($self->repos(), $rev);
+    if (!defined($info_ref->{'Revision'})) {
+      my $url = $self->repos() . ($rev ? '@' . $rev : q{});
+      w_report("ERROR: $url: not a valid URL\n");
+      return 0;
+    }
+    my $lc_rev = $info_ref->{'Last Changed Rev'};
+    $rev       = $info_ref->{'Revision'};
+
+    # Print info if specified revision is not the last commit revision
+    if (uc($self->revision()) ne 'HEAD' && $lc_rev != $rev) {
+      my $message = $self->repos . '@' . $rev . ': last changed at [' .
+                    $lc_rev . '].';
+      if ($self->setting ('EXT_REVMATCH') and uc ($self->revision) ne 'HEAD') {
+        w_report "ERROR: specified and last changed revisions differ:\n",
+                 '       ', $message, "\n";
+        $rc = 0;
+
+      } else {
+        print 'INFO: ', $message, "\n";
+      }
+    }
+
+    if ($self->verbose > 1 and uc ($self->revision) ne 'HEAD') {
+      # See if there is a later change of the branch at the HEAD
+      my $head_lc_rev = $self->_svn_info($self->repos())->{'Last Changed Rev'};
+
+      if (defined($head_lc_rev) && $head_lc_rev != $lc_rev) {
+        # Ensure that this is the same branch by checking its history
+        my @lines = &run_command (
+          [qw/svn log -q --incremental -r/, $lc_rev, $self->repos . '@HEAD'],
+          METHOD => 'qx', TIME => $self->verbose > 2, ERROR => 'ignore',
+        );
+
+        print 'INFO: ', $self->repos, '@', $rev,
+              ': newest commit at [', $head_lc_rev, '].', "\n"
+          if @lines;
+      }
+    }
+
+    $self->revision ($rev) if $rev ne $self->revision;
+
+  } elsif ($self->type eq 'user') {
+    1; # Do nothing
+
+  } else {
+    w_report 'ERROR: ', $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+    $rc = 0;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->expand_path;
+#
+# DESCRIPTION
+#   This method expands the relative path names of sub-directories to full
+#   path names. It returns true on success.
+# ------------------------------------------------------------------------------
+
+sub expand_path {
+  my $self = shift;
+
+  my $rc = 1;
+  if ($self->type eq 'svn') {
+    # SVN repository
+    # Do nothing unless there is a declared repository for this branch
+    return unless $self->repos;
+
+    # Remove trailing /
+    my $repos = $self->repos;
+    $self->repos ($repos) if $repos =~ s#/+$##;
+
+    # Consider all declared (expandable) sub-directories
+    for my $name (qw/dirs expdirs/) {
+      for my $dir (keys %{ $self->$name }) {
+        # Do nothing if declared sub-directory is quoted as a full URL
+        next if &is_url ($self->$name ($dir));
+
+        # Expand sub-directory to full URL
+        $self->$name ($dir, $self->repos . (
+          $self->$name ($dir) ? ('/' . $self->$name ($dir)) : ''
+        ));
+      }
+    }
+    # Note: "catfile" cannot be used in the above statement because it has
+    #       the tendency of removing a slash from double slashes.
+
+  } elsif ($self->type eq 'user') {
+    # Local user directories
+
+    # Expand leading ~ for all declared (expandable) sub-directories
+    for my $name (qw/dirs expdirs/) {
+      for my $dir (keys %{ $self->$name }) {
+        $self->$name ($dir, expand_tilde $self->$name ($dir));
+      }
+    }
+
+    # A top directory for the source is declared
+    if ($self->repos) {
+      # Expand leading ~ for the top directory
+      $self->repos (expand_tilde $self->repos);
+
+      # Get the root directory of the file system
+      my $rootdir = File::Spec->rootdir ();
+
+      # Expand top directory to absolute path, if necessary
+      $self->repos (File::Spec->rel2abs ($self->repos))
+        if $self->repos !~ m/^$rootdir/;
+
+      # Remove trailing /
+      my $repos = $self->repos;
+      $self->repos ($repos) if $repos =~ s#/+$##;
+
+      # Consider all declared (expandable) sub-directories
+      for my $name (qw/dirs expdirs/) {
+        for my $dir (keys %{ $self->$name }) {
+          # Do nothing if declared sub-directory is quoted as a full path
+          next if $self->$name ($dir) =~ m#^$rootdir#;
+
+          # Expand sub-directory to full path
+          $self->$name (
+            $dir, $self->$name ($dir)
+                  ? File::Spec->catfile ($self->repos, $self->$name ($dir))
+                  : $self->repos
+          );
+        }
+      }
+    }
+
+  } else {
+    w_report 'ERROR: ', $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+    $rc = 0;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->expand_all();
+#
+# DESCRIPTION
+#   This method searches the expandable source directories recursively for
+#   source directories containing regular files. The namespaces and the locators
+#   of these sub-directories are then added to the source directory hash table.
+#   Returns true on success.
+# ------------------------------------------------------------------------------
+
+sub expand_all {
+  my ($self) = @_;
+  my %finder_of = (
+    user => sub {
+      my ($root_locator) = @_;
+      my %ns_of;
+      my $wanted = sub {
+        my $base_name = $_;
+        my $path = $File::Find::name;
+        if (-f $path && !-l $path) {
+          my $dir_path      = dirname($path);
+          my $rel_dir_path  = File::Spec->abs2rel($dir_path, $root_locator);
+          if ($rel_dir_path eq q{.}) {
+             $rel_dir_path = q{};
+          }
+          if (!exists($ns_of{$dir_path})) {
+            $ns_of{$dir_path} = [File::Spec->splitdir($rel_dir_path)];
+          }
+        }
+      };
+      find($wanted, $root_locator);
+      return \%ns_of;
+    },
+    svn  => sub {
+      my ($root_locator) = @_;
+      my $runner = sub {
+        map {chomp($_); $_} run_command(
+          ['svn', @_,  '-R', join('@', $root_locator, $self->revision())],
+          METHOD => 'qx', TIME => $self->config()->verbose() > 2,
+        );
+      };
+      # FIXME: check for symlink switched off due to "svn pg" being very slow
+      #my %symlink_in
+      #  = map {($_ =~ qr{\A(.+)\s-\s(\*)\z}xms)} ($runner->(qw{pg svn:special}));
+      #my @locators
+      #  = grep {$_ !~ qr{/\z}xms && !$symlink_in{$_}} ($runner->('ls'));
+      my @locators = grep {$_ !~ qr{/\z}xms} ($runner->('ls'));
+      my %ns_of;
+      for my $locator (@locators) {
+        my ($rel_dir_locator) = $locator =~ qr{\A(.*)/[^/]+\z}xms; # dirname
+        $rel_dir_locator ||= q{};
+        my $dir_locator
+          = $rel_dir_locator ? join(q{/}, $root_locator, $rel_dir_locator)
+          :                    $root_locator
+          ;
+        if (!exists($ns_of{$dir_locator})) {
+          $ns_of{$dir_locator} = [split(q{/}, $rel_dir_locator)];
+        }
+      }
+      return \%ns_of;
+    },
+  );
+
+  if (!defined($finder_of{$self->type()})) {
+    w_report(sprintf(
+        qq{ERROR: %s: resource type "%s" not supported},
+        $self->repos(),
+        $self->type(),
+    ));
+    return;
+  }
+  while (my ($root_ns, $root_locator) = each(%{$self->expdirs()})) {
+    my @root_ns_list = split(qr{$FCM1::Config::DELIMITER}xms, $root_ns);
+    my $ns_hash_ref = $finder_of{$self->type()}->($root_locator);
+    while (my ($dir_path, $ns_list_ref) = each(%{$ns_hash_ref})) {
+      if (!grep {$_ =~ qr{\A\.}xms || $_ =~ qr{~\z}xms} @{$ns_list_ref}) {
+        my $ns = join($FCM1::Config::DELIMITER, @root_ns_list, @{$ns_list_ref});
+        $self->dirs($ns, $dir_path);
+      }
+    }
+  }
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $n = $obj->add_base_dirs ($base);
+#
+# DESCRIPTION
+#   Add a list of source directories to the current branch based on the set
+#   provided by $base, which must be a reference to a FCM1::ReposBranch
+#   instance. It returns the total number of used sub-directories in the
+#   current repositories.
+# ------------------------------------------------------------------------------
+
+sub add_base_dirs {
+  my $self = shift;
+  my $base = shift;
+
+  my %base_dirs = %{ $base->dirs };
+
+  for my $key (keys %base_dirs) {
+    # Remove repository root from base directories
+    if ($base_dirs{$key} eq $base->repos) {
+      $base_dirs{$key} = '';
+
+    } else {
+      $base_dirs{$key} = substr $base_dirs{$key}, length ($base->repos) + 1;
+    }
+
+    # Append base directories to current repository root
+    $self->dirs ($key, $base_dirs{$key});
+  }
+
+  # Expand relative path names of sub-directories
+  $self->expand_path;
+
+  return scalar keys %{ $self->dirs };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines ();
+#
+# DESCRIPTION
+#   This method returns a list of configuration lines for the current branch.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines {
+  my ($self) = @_;
+  my @return = ();
+
+  my $suffix = $self->package . $FCM1::Config::DELIMITER . $self->tag;
+  push @return, FCM1::CfgLine->new (
+    label => $self->cfglabel ('REPOS') . $FCM1::Config::DELIMITER . $suffix,
+    value => $self->repos,
+  ) if $self->repos;
+
+  push @return, FCM1::CfgLine->new (
+    label => $self->cfglabel ('REVISION') . $FCM1::Config::DELIMITER . $suffix,
+    value => $self->revision,
+  ) if $self->revision;
+
+  for my $key (sort keys %{ $self->dirs }) {
+    my $value = $self->dirs ($key);
+
+    # Use relative path where possible
+    if ($self->repos) {
+      if ($value eq $self->repos) {
+        $value = '';
+
+      } elsif (index ($value, $self->repos) == 0) {
+        $value = substr ($value, length ($self->repos) + 1);
+      }
+    }
+
+    # Use top package name where possible
+    my $dsuffix = $key . $FCM1::Config::DELIMITER . $self->tag;
+    $dsuffix = $suffix if $value ne $self->dirs ($key) and $key eq join (
+      $FCM1::Config::DELIMITER, $self->package, File::Spec->splitdir ($value)
+    );
+
+    push @return, FCM1::CfgLine->new (
+      label => $self->cfglabel ('DIRS') . $FCM1::Config::DELIMITER . $dsuffix,
+      value => $value,
+    );
+  }
+
+  push @return, FCM1::CfgLine->new ();
+
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   my $hash_ref = $self->_svn_info($url[, $rev]);
+#
+# DESCRIPTION
+#   Executes "svn info" and returns each field in a hash.
+# ------------------------------------------------------------------------------
+sub _svn_info {
+  my ($self, $url, $rev) = @_;
+  return {
+    map {
+      chomp();
+      my ($key, $value) = split(qr{\s*:\s*}xms, $_, 2);
+      $key ? ($key, $value) : ();
+    } run_command(
+      [qw{svn info}, ($rev ? ('-r', $rev, join('@', $url, $rev)) : $url)], 
+      DEVNULL => 1,
+      ERROR   => 'ignore',
+      METHOD  => 'qx',
+      TIME    => $self->verbose() > 2,
+    )
+  };
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/SrcDirLayer.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/SrcDirLayer.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/SrcDirLayer.pm	(revision 5095)
@@ -0,0 +1,277 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::SrcDirLayer
+#
+# DESCRIPTION
+#   This class contains methods to manipulate the extract of a source
+#   directory from a branch of a (Subversion) repository.
+#
+# ------------------------------------------------------------------------------
+use warnings;
+use strict;
+
+package FCM1::SrcDirLayer;
+use base qw{FCM1::Base};
+
+use FCM1::Util      qw{run_command e_report w_report};
+use File::Basename qw{dirname};
+use File::Path     qw{mkpath};
+use File::Spec;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'cachedir',  # cache directory for this directory branch
+  'commit',    # revision at which the source directory was changed
+  'extracted', # is this branch already extracted?
+  'files',     # list of source files in this directory branch
+  'location',  # location of the source directory in the branch
+  'name',      # sub-package name of the source directory
+  'package',   # top level package name of which the current repository belongs
+  'reposroot', # repository root URL
+  'revision',  # revision of the repository branch
+  'tag',       # package/revision tag of the current repository branch
+  'type',      # type of the repository branch ("svn" or "user")
+);
+
+my %ERR_MESS_OF = (
+    CACHE_WRITE => '%s: cannot write to cache',
+    SYMLINK     => '%s/%s: ignore symbolic link',
+    VC_TYPE     => '%s: repository type not supported',
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = FCM1::SrcDirLayer->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the FCM1::SrcDirLayer class. See
+#   above for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = FCM1::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'files') {
+        # Reference to an array
+        $self->{$name} = [];
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# Handles error/warning events.
+sub _err {
+    my ($key, $args_ref, $warn_only) = @_;
+    my $reporter = $warn_only ? \&w_report : \&e_report;
+    $args_ref ||= [];
+    $reporter->(sprintf($ERR_MESS_OF{$key} . ".\n", @{$args_ref}));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $obj->localdir;
+#
+# DESCRIPTION
+#   This method returns the user or cache directory for the current revision
+#   of the repository branch.
+# ------------------------------------------------------------------------------
+
+sub localdir {
+  my $self = shift;
+
+  return $self->user ? $self->location : $self->cachedir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $user = $obj->user;
+#
+# DESCRIPTION
+#   This method returns the string "user" if the current source directory
+#   branch is a local directory. Otherwise, it returns "undef".
+# ------------------------------------------------------------------------------
+
+sub user {
+  my $self = shift;
+
+  return $self->type eq 'user' ? 'user' : undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $obj->get_commit;
+#
+# DESCRIPTION
+#   If the current repository type is "svn", this method attempts to obtain
+#   the revision in which the branch is last committed. On a successful
+#   operation, it returns this revision number. Otherwise, it returns
+#   "undef".
+# ------------------------------------------------------------------------------
+
+sub get_commit {
+  my $self = shift;
+
+  if ($self->type eq 'svn') {
+    # Execute the "svn info" command
+    my @lines   = &run_command (
+      [qw/svn info -r/, $self->revision, $self->location . '@' . $self->revision],
+      METHOD => 'qx', TIME => $self->config->verbose > 2,
+    );
+
+    my $rev;
+    for (@lines) {
+      if (/^Last\s+Changed\s+Rev\s*:\s*(\d+)/i) {
+        $rev = $1;
+        last;
+      }
+    }
+
+    # Commit revision of this source directory
+    $self->commit ($rev);
+
+    return $self->commit;
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    _err('VC_TYPE', [$self->type()]);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->update_cache;
+#
+# DESCRIPTION
+#   If the current repository type is "svn", this method attempts to extract
+#   the current revision source directory from the current branch from the
+#   repository, sending the output to the cache directory. It returns true on
+#   a successful operation, or false if the repository is not of type "svn".
+# ------------------------------------------------------------------------------
+
+sub update_cache {
+  my $self = shift;
+
+  return unless $self->cachedir;
+
+  # Create cache extract destination, if necessary
+  my $dirname = dirname $self->cachedir;
+  mkpath($dirname);
+
+  if (!-d $dirname) {
+    _err('CACHE_WRITE', [$dirname]);
+  }
+  
+  if ($self->type eq 'svn') {
+    # Set up the extract command, "svn export --force -q -N"
+    my @command = (
+      qw/svn export --force -q -N/,
+      $self->location . '@' . $self->revision,
+      $self->cachedir,
+    );
+
+    &run_command (\@command, TIME => $self->config->verbose > 2);
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    _err('VC_TYPE', [$self->type()]);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @files = $obj->get_files();
+#
+# DESCRIPTION
+#   This method returns a list of file base names in the (cache of) this source
+#   directory in the current branch.
+# ------------------------------------------------------------------------------
+
+sub get_files {
+  my ($self) = @_;
+  opendir(my $dir, $self->localdir())
+    || die($self->localdir(), ': cannot read directory');
+  my @base_names = ();
+  BASE_NAME:
+  while (my $base_name = readdir($dir)) {
+    if ($base_name =~ qr{\A\.}xms || $base_name =~ qr{~\z}xms) {
+        next BASE_NAME;
+    }
+    my $path = File::Spec->catfile($self->localdir(), $base_name);
+    if (-d $path) {
+        next BASE_NAME;
+    }
+    if (-l $path) {
+        _err('SYMLINK', [$self->location(), $base_name], 1);
+        next BASE_NAME;
+    }
+    push(@base_names, $base_name);
+  }
+  closedir($dir);
+  $self->files(\@base_names);
+  return @base_names;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Timer.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Timer.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Timer.pm	(revision 5095)
@@ -0,0 +1,85 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::Timer
+#
+# DESCRIPTION
+#   This is a package of timer utility used by the FCM command.
+#
+# ------------------------------------------------------------------------------
+
+package FCM1::Timer;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Exports
+our (@ISA, @EXPORT, @EXPORT_OK);
+
+sub timestamp_command;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(timestamp_command);
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %cmd_start_time = (); # Command start time, (key = command, value = time)
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &FCM1::Timer::timestamp_command ($command[, $status]);
+#
+# DESCRIPTION
+#   This function returns a string adding to $command a prefix according the
+#   value of $status. If $status is not specified or does not match the word
+#   "end", the status is assumed to be "start". At "start", the prefix will
+#   contain the current timestamp. If $status is the word "end", the prefix
+#   will contain the total time taken since this function was called with the
+#   same $command at the "start" status.
+# ------------------------------------------------------------------------------
+
+sub timestamp_command {
+  (my $command, my $status) = @_;
+
+  my $prefix;
+  if ($status and $status =~ /end/i) {
+    # Status is "end", insert time taken
+    my $lapse = time () - $cmd_start_time{$command};
+    $prefix = sprintf "# Time taken: %12d s=> ", $lapse;
+
+  } else {
+    # Status is "start", insert time stamp
+    $cmd_start_time{$command} = time;
+
+    (my $sec, my $min, my $hour, my $mday, my $mon, my $year) = localtime;
+    $prefix = sprintf "# Start: %04d-%02d-%02d %02d:%02d:%02d=> ",
+              $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
+  }
+
+  return $prefix . $command . "\n";
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Util.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Util.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Util.pm	(revision 5095)
@@ -0,0 +1,564 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+# NAME
+#   FCM1::Util
+#
+# DESCRIPTION
+#   This is a package of misc utilities used by the FCM command.
+#
+# ------------------------------------------------------------------------------
+
+use warnings;
+use strict;
+
+package FCM1::Util;
+require Exporter;
+our @ISA = qw{Exporter};
+
+sub expand_tilde;
+sub e_report;
+sub find_file_in_path;
+sub get_command_string;
+sub get_rev_of_wc;
+sub get_url_of_wc;
+sub get_url_peg_of_wc;
+sub get_wct;
+sub is_url;
+sub is_wc;
+sub print_command;
+sub run_command;
+sub svn_date;
+sub tidy_url;
+sub touch_file;
+sub w_report;
+
+our @EXPORT = qw{
+    expand_tilde
+    e_report
+    find_file_in_path
+    get_command_string
+    get_rev_of_wc
+    get_url_of_wc
+    get_url_peg_of_wc
+    get_wct
+    is_url
+    is_wc
+    print_command
+    run_command
+    svn_date
+    tidy_url
+    touch_file
+    w_report
+};
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Find;
+use File::Path;
+use File::Spec;
+use POSIX qw{strftime SIGINT SIGKILL SIGTERM WEXITSTATUS WIFSIGNALED WTERMSIG};
+
+# FCM component modules
+use FCM1::Timer;
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %svn_info       = (); # "svn info" log, (key1 = path,
+                         # key2 = URL, Revision, Last Changed Rev)
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %srcdir = &FCM1::Util::find_file_in_path ($file, \@path);
+#
+# DESCRIPTION
+#   Search $file in @path. Returns the full path of the $file if it is found
+#   in @path. Returns "undef" if $file is not found in @path.
+# ------------------------------------------------------------------------------
+
+sub find_file_in_path {
+  my ($file, $path) = @_;
+
+  for my $dir (@$path) {
+    my $full_file = File::Spec->catfile ($dir, $file);
+    return $full_file if -e $full_file;
+  }
+
+  return undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $expanded_path = &FCM1::Util::expand_tilde ($path);
+#
+# DESCRIPTION
+#   Returns an expanded path if $path is a path that begins with a tilde (~).
+# ------------------------------------------------------------------------------
+
+sub expand_tilde {
+  my $file = $_[0];
+
+  $file =~ s#^~([^/]*)#$1 ? (getpwnam $1)[7] : ($ENV{HOME} || $ENV{LOGDIR})#ex;
+
+  # Expand . and ..
+  while ($file =~ s#/+\.(?:/+|$)#/#g) {next}
+  while ($file =~ s#/+[^/]+/+\.\.(?:/+|$)#/#g) {next}
+
+  # Remove trailing /
+  $file =~ s#/*$##;
+
+  return $file;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &FCM1::Util::touch_file ($file);
+#
+# DESCRIPTION
+#   Touch $file if it exists. Create $file if it does not exist. Return 1 for
+#   success or 0 otherwise.
+# ------------------------------------------------------------------------------
+
+sub touch_file {
+  my $file = $_[0];
+  my $rc   = 1;
+
+  if (-e $file) {
+    my $now = time;
+    $rc = utime $now, $now, $file;
+
+  } else {
+    mkpath dirname ($file) unless -d dirname ($file);
+
+    $rc = open FILE, '>', $file;
+    $rc = close FILE if $rc;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = &is_wc ([$path]);
+#
+# DESCRIPTION
+#   Returns true if current working directory (or $path) is a Subversion
+#   working copy.
+# ------------------------------------------------------------------------------
+
+sub is_wc {
+  my $path = shift() || cwd();
+  my $path_of_dir = -f $path ? dirname($path) : $path;
+  if (-e File::Spec->catfile($path_of_dir, qw{.svn entries})) {
+      return 1;
+  }
+  my $inforc = &run_command (
+    [qw/svn info/, $path_of_dir],
+    METHOD => 'qx', DEVNULL => 1, ERROR => 'ignore'
+  );
+  return $inforc != 0;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = &is_url ($url);
+#
+# DESCRIPTION
+#   Returns true if $url is a URL.
+# ------------------------------------------------------------------------------
+
+sub is_url {
+  # This should handle URL beginning with svn://, http:// and svn+ssh://
+  return ($_[0] =~ m#^[\+\w]+://#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = tidy_url($url);
+#
+# DESCRIPTION
+#   Returns a tidied version of $url by removing . and .. in the path.
+# ------------------------------------------------------------------------------
+
+sub tidy_url {
+    my ($url) = @_;
+    if (!is_url($url)) {
+        return $url;
+    }
+    my $DOT_PATTERN     = qr{/+ \. (?:/+|(@|\z))}xms;
+    my $DOT_DOT_PATTERN = qr{/+ [^/]+ /+ \.\. (?:/+|(@|\z))}xms;
+    my $TRAILING_SLASH_PATTERN = qr{([^/]+) /* (@|\z)}xms;
+    my $RIGHT_EVAL = q{'/' . ($1 ? $1 : '')};
+    DOT:
+    while ($url =~ s{$DOT_PATTERN}{$RIGHT_EVAL}eegxms) {
+        next DOT;
+    }
+    DOT_DOT:
+    while ($url =~ s{$DOT_DOT_PATTERN}{$RIGHT_EVAL}eegxms) {
+        next DOT_DOT;
+    }
+    $url =~ s{$TRAILING_SLASH_PATTERN}{$1$2}xms;
+    return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_wct ([$dir]);
+#
+# DESCRIPTION
+#   If current working directory (or $dir) is a Subversion working copy,
+#   returns the top directory of this working copy; otherwise returns an empty
+#   string.
+# ------------------------------------------------------------------------------
+
+sub get_wct {
+  my $dir = @_ ? $_[0] : cwd ();
+
+  return '' if not &is_wc ($dir);
+
+  my $updir = dirname $dir;
+  while (&is_wc ($updir)) {
+    $dir   = $updir;
+    $updir = dirname $dir;
+    last if $updir eq $dir;
+  }
+
+  return $dir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_url_of_wc ([$path[, $refresh]]);
+#
+# DESCRIPTION
+#   If current working directory (or $path) is a Subversion working copy,
+#   returns the URL of the associated Subversion repository; otherwise returns
+#   an empty string. If $refresh is specified, do not use the cached
+#   information.
+# ------------------------------------------------------------------------------
+
+sub get_url_of_wc {
+  my $path    = @_ ? $_[0] : cwd ();
+  my $refresh = exists $_[1] ? $_[1] : 0;
+  my $url  = '';
+
+  if (&is_wc ($path)) {
+    delete $svn_info{$path} if $refresh;
+    &_invoke_svn_info (PATH => $path) unless exists $svn_info{$path};
+    $url = $svn_info{$path}{URL};
+  }
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_url_peg_of_wc ([$path[, $refresh]]);
+#
+# DESCRIPTION
+#   If current working directory (or $path) is a Subversion working copy,
+#   returns the URL@REV of the associated Subversion repository; otherwise
+#   returns an empty string. If $refresh is specified, do not use the cached
+#   information.
+# ------------------------------------------------------------------------------
+
+sub get_url_peg_of_wc {
+  my $path    = @_ ? $_[0] : cwd ();
+  my $refresh = exists $_[1] ? $_[1] : 0;
+  my $url  = '';
+
+  if (&is_wc ($path)) {
+    delete $svn_info{$path} if $refresh;
+    &_invoke_svn_info (PATH => $path) unless exists $svn_info{$path};
+    $url = $svn_info{$path}{URL} . '@' . $svn_info{$path}{Revision};
+  }
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &_invoke_svn_info (PATH => $path);
+#
+# DESCRIPTION
+#   The function is internal to this module. It invokes "svn info" on $path to
+#   gather information on URL, Revision and Last Changed Rev. The information
+#   is stored in a hash table at the module level, so that the information can
+#   be re-used.
+# ------------------------------------------------------------------------------
+
+sub _invoke_svn_info {
+  my %args = @_;
+  my $path = $args{PATH};
+  my $cfg  = FCM1::Config->instance();
+
+  return if exists $svn_info{$path};
+
+  # Invoke "svn info" command
+  my @info = &run_command (
+    [qw/svn info/, $path],
+    PRINT => $cfg->verbose > 2, METHOD => 'qx', DEVNULL => 1, ERROR => 'ignore',
+  );
+  for (@info) {
+    chomp;
+
+    if (/^(URL|Revision|Last Changed Rev):\s*(.+)$/) {
+      $svn_info{$path}{$1} = $2;
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_command_string ($cmd);
+#   $string = &get_command_string (\@cmd);
+#
+# DESCRIPTION
+#   The function returns a string by converting the list in @cmd or the scalar
+#   $cmd to a form, where it can be executed as a shell command.
+# ------------------------------------------------------------------------------
+
+sub get_command_string {
+  my $cmd    = $_[0];
+  my $return = '';
+
+  if (ref ($cmd) and ref ($cmd) eq 'ARRAY') {
+    # $cmd is a reference to an array
+
+    # Print each argument
+    for my $i (0 .. @{ $cmd } - 1) {
+      my $arg = $cmd->[$i];
+
+      $arg =~ s/./*/g if $i > 0 and $cmd->[$i - 1] eq '--password';
+
+      if ($arg =~ /[\s'"*?]/) {
+        # Argument contains a space, quote it
+        if (index ($arg, "'") >= 0) {
+          # Argument contains an apostrophe, quote it with double quotes
+          $return .= ($i > 0 ? ' ' : '') . '"' . $arg . '"';
+
+        } else {
+          # Otherwise, quote argument with apostrophes
+          $return .= ($i > 0 ? ' ' : '') . "'" . $arg . "'";
+        }
+
+      } else {
+        # Argument does not contain a space, just print it
+        $return .= ($i > 0 ? ' ' : '') . ($arg eq '' ? "''" : $arg);
+      }
+    }
+
+  } else {
+    # $cmd is a scalar, just print it "as is"
+    $return = $cmd;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &print_command ($cmd);
+#   &print_command (\@cmd);
+#
+# DESCRIPTION
+#   The function prints the list in @cmd or the scalar $cmd, as it would be
+#   executed by the shell.
+# ------------------------------------------------------------------------------
+
+sub print_command {
+  my $cmd = $_[0];
+
+  print '=> ', &get_command_string ($cmd) , "\n";
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @return = &run_command (\@cmd, <OPTIONS>);
+#   @return = &run_command ($cmd , <OPTIONS>);
+#
+# DESCRIPTION
+#   This function executes the command in the list @cmd or in the scalar $cmd.
+#   The remaining are optional arguments in a hash table. Valid options are
+#   listed below. If the command is run using "qx", the function returns the
+#   standard output from the command. If the command is run using "system", the
+#   function returns true on success. By default, the function dies on failure.
+#
+# OPTIONS
+#   METHOD  => $method - this can be "system", "exec" or "qx". This determines
+#                        how the command will be executed. If not set, the
+#                        default is to run the command with "system".
+#   PRINT   => 1       - if set, print the command before executing it.
+#   ERROR   => $flag   - this should only be set if METHOD is set to "system"
+#                        or "qx". The $flag can be "die" (default), "warn" or
+#                        "ignore". If set to "die", the function dies on error.
+#                        If set to "warn", the function issues a warning on
+#                        error, and the function returns false. If set to
+#                        "ignore", the function returns false on error.
+#   RC      => 1       - if set, must be a reference to a scalar, which will be
+#                        set to the return code of the command.
+#   DEVNULL => 1       - if set, re-direct STDERR to /dev/null before running
+#                        the command.
+#   TIME    => 1       - if set, print the command with a timestamp before
+#                        executing it, and print the time taken when it
+#                        completes. This option supersedes the PRINT option.
+# ------------------------------------------------------------------------------
+
+sub run_command {
+  my ($cmd, %input_opt_of) = @_;
+  my %opt_of = (
+    DEVNULL => undef,
+    ERROR   => 'die',
+    METHOD  => 'system',
+    PRINT   => undef,
+    RC      => undef,
+    TIME    => undef,
+    %input_opt_of,
+  );
+  local($|) = 1; # Make sure STDOUT is flushed before running command
+
+  # Print the command before execution, if necessary
+  if ($opt_of{TIME}) {
+    print(timestamp_command(get_command_string($cmd)));
+  }
+  elsif ($opt_of{PRINT}) {
+    print_command($cmd);
+  }
+
+  # Re-direct STDERR to /dev/null if necessary
+  if ($opt_of{DEVNULL}) {
+    no warnings;
+    open(OLDERR, ">&STDERR") || croak("Cannot dup STDERR ($!), abort");
+    use warnings;
+    open(STDERR, '>', File::Spec->devnull())
+      || croak("Cannot redirect STDERR ($!), abort");
+    # Make sure the channels are unbuffered
+    my $select = select();
+    select(STDERR); local($|) = 1;
+    select($select);
+  }
+
+  my @return = ();
+  if (ref($cmd) && ref($cmd) eq 'ARRAY') {
+    # $cmd is an array
+    my @command = @{$cmd};
+    if ($opt_of{METHOD} eq 'qx') {
+      @return = qx(@command);
+    }
+    elsif ($opt_of{METHOD} eq 'exec') {
+      exec(@command);
+    }
+    else {
+      system(@command);
+      @return = $? ? () : (1);
+    }
+  }
+  else {
+    # $cmd is an scalar
+    if ($opt_of{METHOD} eq 'qx') {
+      @return = qx($cmd);
+    }
+    elsif ($opt_of{METHOD} eq 'exec') {
+      exec($cmd);
+    }
+    else {
+      system($cmd);
+      @return = $? ? () : (1);
+    }
+  }
+  my $rc = $?;
+
+  # Put STDERR back to normal, if redirected previously
+  if ($opt_of{DEVNULL}) {
+    close(STDERR);
+    open(STDERR, ">&OLDERR") || croak("Cannot dup STDERR ($!), abort");
+  }
+
+  # Print the time taken for command after execution, if necessary
+  if ($opt_of{TIME}) {
+    print(timestamp_command(get_command_string($cmd), 'end'));
+  }
+
+  # Signal and return code
+  my ($signal, $status) = (WTERMSIG($rc), WEXITSTATUS($rc));
+  if (exists($opt_of{RC})) {
+    ${$opt_of{RC}} = $status;
+  }
+  if (WIFSIGNALED($rc) && grep {$signal == $_} (SIGINT, SIGKILL, SIGTERM)) {
+    croak(sprintf('%s terminated (%d)', get_command_string($cmd), $signal));
+  }
+  if ($status && $opt_of{ERROR} ne 'ignore') {
+    my $func_ref = $opt_of{ERROR} eq 'warn' ? \&carp : \&croak;
+    $func_ref->(sprintf('%s failed (%d)', get_command_string($cmd), $status));
+  }
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &e_report (@message);
+#
+# DESCRIPTION
+#   The function prints @message to STDERR and aborts with a error.
+# ------------------------------------------------------------------------------
+
+sub e_report {
+  print STDERR @_, "\n" if @_;
+
+  exit 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &w_report (@message);
+#
+# DESCRIPTION
+#   The function prints @message to STDERR and returns.
+# ------------------------------------------------------------------------------
+
+sub w_report {
+  print STDERR @_, "\n" if @_;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $date = &svn_date ($time);
+#
+# DESCRIPTION
+#   The function returns a date, formatted as by Subversion. The argument $time
+#   is the number of seconds since epoch.
+# ------------------------------------------------------------------------------
+
+sub svn_date {
+  my $time = shift;
+
+  return strftime ('%Y-%m-%d %H:%M:%S %z (%a, %d %b %Y)', localtime ($time));
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Util/ClassLoader.pm
===================================================================
--- LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Util/ClassLoader.pm	(revision 5095)
+++ LMDZ6/branches/Amaury_dev/tools/fcm/lib/FCM1/Util/ClassLoader.pm	(revision 5095)
@@ -0,0 +1,93 @@
+# ------------------------------------------------------------------------------
+# Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+#
+# This file is part of FCM, tools for managing and building source code.
+#
+# FCM is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# FCM is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with FCM. If not, see <http://www.gnu.org/licenses/>.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package FCM1::Util::ClassLoader;
+use base qw{Exporter};
+
+our @EXPORT_OK = qw{load};
+
+use Carp qw{croak};
+use FCM1::Exception;
+
+sub load {
+    my ($class, $test_method) = @_;
+    if (!$test_method) {
+        $test_method = 'new';
+    }
+    if (!UNIVERSAL::can($class, $test_method)) {
+        eval('require ' . $class);
+        if ($@) {
+            croak(FCM1::Exception->new({message => sprintf(
+                "%s: class loading failed: %s", $class, $@,
+            )}));
+        }
+    }
+    return $class;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+FCM1::ClassLoader
+
+=head1 SYNOPSIS
+
+    use FCM1::Util::ClassLoader;
+    $load_ok = FCM1::Util::ClassLoader::load($class);
+
+=head1 DESCRIPTION
+
+A wrapper for loading a class dynamically.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item load($class,$test_method)
+
+If $class can call $test_method, returns $class. Otherwise, attempts to
+require() $class and returns it. If this fails, croak() with a
+L<FCM1::Exception|FCM1::Exception>.
+
+=item load($class)
+
+Shorthand for C<load($class, 'new')>.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<FCM1::Exception|FCM1::Exception>
+
+The load($class,$test_method) function croak() with this exception if it fails
+to load the specified class.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006-2021 British Crown (Met Office) & Contributors.
+
+=cut
