source: OFFICIAL/FCM_V1.3/lib/Fcm/Dest.pm

#!/usr/bin/perl
# ------------------------------------------------------------------------------
# NAME
#   Fcm::Dest
#
# DESCRIPTION
#   This class contains methods to set up a destination location of an FCM
#   extract/build.
#
# COPYRIGHT
#   (C) Crown copyright Met Office. All rights reserved.
#   For further details please refer to the file COPYRIGHT.txt
#   which you should have received as part of this distribution.
# ------------------------------------------------------------------------------

package Fcm::Dest;
@ISA = qw(Fcm::Base);

# Standard pragma
use warnings;
use strict;

# Standard modules
use Carp;
use Cwd;
use File::Basename;
use File::Find;
use File::Path;
use File::Spec;
use Sys::Hostname;

# In-house modules
use Fcm::Base;
use Fcm::CfgLine;
use Fcm::Util;

# 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');
for (@subdirs) {
  (my $name = $_) =~ s/dir$/path/;
  push @paths, $name;
}

# List of normal properties
my @scalar_properties = (
  'dest0',      # the original destination (if current destination is a mirror)
  'inherit',    # list of inherited Fcm::Dest objects
  'logname',    # remote login name
  'lockfile',   # lock file
  'machine',    # remote machine
  'mirror_cmd', # mirror command to use
  'rootdir',    # destination root directory
  'type',       # destination type, "bld" (default) or "ext"
);

# ------------------------------------------------------------------------------
# SYNOPSIS
#   $obj = Fcm::Dest->new (%args);
#
# DESCRIPTION
#   This method constructs a new instance of the Fcm::Dest 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 = Fcm::Base->new (%args);

  bless $self, $class;

  for (@scalar_properties) {
    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
  }

  for (@subdirs, @paths, @lockfiles, @cfgfiles) {
    $self->{$_} = undef;
  }

  return $self;
}

# ------------------------------------------------------------------------------
# SYNOPSIS
#   $self->DESTROY;
#
# DESCRIPTION
#   This method is called automatically when the Fcm::Dest object is
#   destroyed.
# ------------------------------------------------------------------------------

sub DESTROY {
  my $self = shift;

  # Remove the lockfile if it is set
  unlink $self->lockfile if $self->lockfile and -w $self->lockfile;

  return;
}

# ------------------------------------------------------------------------------
# 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;

    # Set property to specified value
    if (@_) {
      $self->{$name} = $_[0];

      if ($name eq 'rootdir') {
        # If root is changed, reset locations derived from it
        for (@cfgfiles, @lockfiles, @miscfiles_bld, @subdirs) {
          $self->{$_} = undef;
        }

      } elsif ($name eq 'inherit') {
        # If list of inherited destinations has changed, reset search paths
        for (@paths) {
          $self->{$_} = undef;
        }
      }
    }

    # Default value for property
    if (not defined $self->{$name}) {
      if ($name eq 'inherit') {
        # Set to reference to empty array
        $self->{$name} = [];

      } elsif ($name eq 'logname') {
        # Attempt to get logname from the current logname
        $self->{$name} = $self->config->user_id;

      } elsif ($name eq 'machine') {
        # Use current hostname
        $self->{$name} = &hostname();

      } elsif ($name eq 'mirror_cmd') {
        # Use default mirror command from config setting
        $self->{$name} = $self->setting (qw/TOOL MIRROR/);

      } elsif ($name eq 'type') {
        # Default to build destination
        $self->{$name} = 'bld';
      }
    }

    return $self->{$name};
  }
}

# ------------------------------------------------------------------------------
# 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 @files;
  if (exists $args{ITEM} and $args{ITEM}) {
    # Remove only selected directories
    @files = @{ $args{ITEM} };

  } else {
    # Remove cachedir and read-write sub-directories for extract or build
    @files = (
      'cachedir',
      ($self->type eq 'ext' ? @subdirs_ext : (@subdirs_bld, @miscfiles_bld)),
    );
  }

  for my $name (@files) {
    my $item     = $self->$name;
    my $clean_ok = 1;

    my @files;
    if (-d $item and $mode ne 'ALL') {
      # Read contents in directory
      opendir DIR, $item;
      @files = grep !/^\.\.?$/, readdir DIR;
      closedir DIR;

      # OK to remove if it is empty
      $clean_ok = not @files;

    } elsif (-f $item and $mode ne 'ALL') {
      $clean_ok = 0;
    }

    # Remove only if it is OK to do so
    next unless $clean_ok;

    # If $item exists and writable by the user, remove it
    if (-w $item) {
      if (-d $item and $mode eq 'CONTENT') {
        print 'Remove contents in : ', $item, "\n"
          if $self->verbose > 1;

        for my $file (@files) {
          rmtree (File::Spec->catfile ($item, $file));
        }

      } else {
        print 'Remove: ', $item, "\n" if $self->verbose > 1;
        rmtree $item;
      }
    }

    # If $item still exists, issue warning
    if (-e $item and not $mode eq 'CONTENT') {
      w_report 'ERROR: ', $item, ': cannot remove.';
      $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
    unless (-d $dir and -w $dir) {
      w_report 'ERROR: ', $dir, ': cannot write to 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 @binpath = grep {-d} @{ $self->binpath };
  my $etc_dir  = -d $self->etcdir ? $self->etcdir : undef;

  # Create a runtime environment script if necessary
  if (@binpath or $etc_dir) {
    my $file = $self->bldrunenvsh;

    open FILE, '>', $file or croak $file, ': cannot open (', $!, '), abort';
    print FILE '#!', $self->setting(qw/TOOL SHELL/), "\n";
    print FILE 'PATH=', join (':', (@binpath, '$PATH')), "\n" if @binpath;
    print FILE 'FCM_ETCDIR=', $self->etcdir, "\n" if $etc_dir;
    print FILE 'export PATH FCM_ETCDIR';
    close FILE or croak $file, ': cannot close (', $!, '), abort';

    # Create symbolic links fcm_env.ksh and bin/fcm_env.ksh for backward
    # compatibility
    my $old_runenv = 'fcm_env.ksh';
    my @symlinks = (
      File::Spec->catfile ($self->rootdir, $old_runenv),
      (-d $self->bindir ? File::Spec->catfile ($self->bindir, $old_runenv) : ()),
    );

    for my $link (@symlinks) {
      # Remove old link if necessary
      if (-l $link) {
        unlink $link if readlink ($link) ne $file;

      } elsif (-e $link) {
        unlink $link;
      }

      # Create the new link
      symlink $file, $link if not -l $link;
    }

    # Information on the location/usage of the runtime environment script
    if ($self->verbose > 1 and $file) {
      print '# ', '-' x 78, "\n";
      print '# To use this build, source the following shell script:', "\n";
      print '. ', $file, "\n";
      print '# ', '-' x 78, "\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
      return if not -r $File::Find::name; # ignore unreadable files

      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 Fcm::Dest for a local
#   destination) to this destination.
# ------------------------------------------------------------------------------

sub mirror {
  my ($self, $items) = @_;

  my $rc = 1;

  if ($self->authority or $self->dest0->rootdir ne $self->rootdir) {
    # Diagnostic
    if ($self->verbose) {
      print 'Destination: ' . ($self->authority ? $self->authority . ':' : '') .
            $self->rootdir . "\n";
    }

    # Check whether mirror command is implemented
    my $method = '_mirror_with_' . $self->mirror_cmd;
    if ($self->can ($method)) {
      $rc = $self->$method ($self->dest0, $items);

    } else {
      # Unknown mirroring tool
      w_report $self->mirror_cmd, ': unknown mirroring tool, abort.';
      $rc = 0;
    }
  }

  return $rc;
}

# ------------------------------------------------------------------------------
# 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) = @_;

  my $rsh   = $self->setting (qw/TOOL REMOTE_SHELL/);
  my $rhost = $self->authority ? $self->authority . ':' : '';

  for my $label (@$items) {
    # Create container directory, as rsync does not do it automatically
    my $dir = dirname $self->$label;

    if ($self->authority) {
      # Create container directory using remote shell
      &run_command (
        [$rsh, $self->machine, '-n', '-l', $self->logname, qw/mkdir -p/, $dir],
        TIME => $self->verbose > 2
      );

    } else {
      mkpath $dir;
    }

    # Build the rsync command
    my @command = (
      qw/rsync -a --exclude='.*' --delete-excluded --timeout=900/,
      '--rsh=' . $rsh,
      ($self->verbose > 2 ? '-v' : ()),
      $dest0->$label, $rhost . $dir,
    );

    # Execute command
    &run_command (\@command, 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 @return = ();

  my $dest_label = $self->cfglabel ($self->dest0 ? 'RDEST' : 'DEST');

  push @return, Fcm::CfgLine->new (
    label => $dest_label . ($index ? $Fcm::Config::DELIMITER . $index : ''),
    value => $self->rootdir,
  );

  if ($self->dest0) {
    my @names = ();
    push @names, 'logname'
      if $self->logname ne $self->config->user_id;
    push @names, 'mirror_cmd'
      if $self->mirror_cmd ne $self->setting (qw/TOOL MIRROR/);
    push @names, 'machine'
      if $self->machine ne &hostname ();

    for my $name (@names) {
      my $sub_label = $Fcm::Config::DELIMITER . uc ($name)
                      . ($index ? $Fcm::Config::DELIMITER . $index : '');
      push @return, Fcm::CfgLine->new (
        label => $dest_label . $sub_label, 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;
}

# ------------------------------------------------------------------------------

1;

__END__