ecearth3/sources/nemo-3.6/EXTERNAL/fcm/bin/fcm_update_version_dir.pl

#!/usr/bin/env perl
#-------------------------------------------------------------------------------
# (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.
#-------------------------------------------------------------------------------

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/../lib";
use Cwd qw{cwd};
use Getopt::Long qw{GetOptions};
use Fcm::Config;
use Fcm::Keyword;
use Fcm::Util qw{get_url_of_wc get_wct is_wc run_command tidy_url};
use File::Basename qw{basename dirname};
use File::Path qw{mkpath};
use File::Spec;
use Pod::Usage qw{pod2usage};

# Usage
# ------------------------------------------------------------------------------
my $this  = basename($0);

# Options
# ------------------------------------------------------------------------------
my ($dest, $full, $help, $url);
my $rc = GetOptions(
  'dest|d=s' => \$dest,
  'full|f'   => \$full,
  'help'     => \$help,
  'url|u=s'  => \$url,
);
if (!$rc) {
  pod2usage({'-verbose' => 1});
}
if ($help) {
  pod2usage({'-exitval' => 0, '-verbose' => 1});
}
if (!$url) {
  pod2usage(
    {'-message' => 'The --url=URL option is compulsory', '-verbose' => 1},
  );
}
$dest ||= cwd();

# Arguments
# ------------------------------------------------------------------------------
if (@ARGV) {
  die 'Cannot read: ', $ARGV[0], ', abort' unless -f $ARGV[0] and -r $ARGV[0];
}

# Get configuration settings
# ------------------------------------------------------------------------------
my $config = Fcm::Config->new ();
$config->get_config ();

# Expand URL keyword
$url = Fcm::Util::tidy_url(Fcm::Keyword::expand($url));

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

MAIN: {
  my $date = localtime;
  print $this, ': started on ', $date, "\n";

  my %dirs;

  # Read input (file) for a list directories and update conditions
  while (<>) {
    chomp;

    # Ignore empty and comment lines
    next if /^\s*(?:#|$)/;

    # Each line must contain a relative path, and optionally a list of
    # space delimited conditions
    my @words = split /\s+/;
    my $dir   = shift @words;

    # Check that the conditions are valid
    my @conditions;
    for my $word (@words) {
      if ($word =~ /^([<>]=?|[!=]=)(.+)$/i) {
        # Condition must be a conditional operator followed by a revision
        my ($operator, $rev) = ($1, $2);
        $rev = (Fcm::Keyword::expand($url, $rev))[1];
        push @conditions, $operator . $rev;

      } else {
        print STDERR 'Warning: ignore unknown syntax for update condition: ',
                     $word, "\n";
      }
    }

    # Add directory and its conditions to a hash
    if ($dir =~ s#/\*$##) { # Directory finishes with wildcard

      # Run "svn ls" in recursive mode
      my $dirurl  = join ('/', ($url, $dir));
      my @files   = &run_command ([qw/svn ls -R/, $dirurl], METHOD => 'qx');

      # Find directories containing regular files
      while (my $file = shift @files) {
	# Skip directories
	next if $file =~ m#/$#;

	# Get "dirname" of regular file and add to hash
	my $subdir = join ('/', ($dir, dirname ($file)));
	$dirs{$subdir} = \@conditions;
      }

    } else {
      $dirs{$dir} = \@conditions;
    }

  }

  # Update each directory, if required
  for my $dir (sort keys %dirs) {
    # Use "svn log" to determine the revisions that need to be updated
    my %allversions;
    {
      my $command = 'svn log -q ' . join ('/', ($url, $dir));
      my @log     = &run_command (
        [qw/svn log -q/, join ('/', ($url, $dir))], METHOD => 'qx',
      );
      @log        = grep /^r\d+/, @log;

      # Assign a sequential "version" number to each sub-directory
      my $version = scalar @log;
      for (@log) {
        m/^r(\d+)/;
        $allversions{$1} = 'v' . $version--;
      }
    }
    my %versions = %allversions;

    # Extract only revisions matching the conditions
    if (@{ $dirs{$dir} }) {
      my @conditions = @{ $dirs{$dir} };

      for my $condition (@conditions) {
        for my $rev (keys %versions) {
          delete $versions{$rev} unless eval ($rev . $condition);
        }
      }
    }

    # Destination directory
    my $dirpath = File::Spec->catfile ($dest, $dir);

    if (-d $dirpath) {
      if ($full or not keys %versions) {
        # Remove destination directory top, in full mode
        # or if there are no matching revisions
        &run_command ([qw/rm -rf/, $dirpath], PRINT => 1);

      } else {
        # Delete excluded revisions if they exist, in incremental mode
        if (opendir DIR, $dirpath) {
          while (my $rev = readdir 'DIR') {
            next unless $rev =~ /^\d+$/;

            if (not grep {$_ eq $rev} keys %versions) {
              my @command = (qw/rm -rf/, File::Spec->catfile ($dirpath, $rev));
              &run_command (\@command, PRINT => 1);

              # Remove "version" symlink
              my $verlink = File::Spec->catfile ($dirpath, $allversions{$rev});
              unlink $verlink if -l $verlink;
            }
          }
          closedir DIR;
        }
      }
    }

    # Create container directory of destination if it does not already exist
    if (keys %versions and not -d $dirpath) {
      print '-> mkdir -p ', $dirpath, "\n";
      my $rc = mkpath $dirpath;
      die 'mkdir -p ', $dirpath, ' failed' unless $rc;
    }

    # Update each version directory that needs updating
    for my $rev (keys %versions) {
      my $revpath = File::Spec->catfile ($dest, $dir, $rev);

      # Create version directory if it does not exist
      if (not -e $revpath) {
        # Use "svn export" to create the version directory
        my @command = (
          qw/svn export -q -r/,
          $rev,
          join ('/', ($url, $dir)),
          $revpath,
        );

        &run_command (\@command, PRINT => 1);
      }

      # Create "version" symlink if necessary
      my $verlink = File::Spec->catfile ($dest, $dir, $versions{$rev});
      symlink $rev, $verlink unless -l $verlink;
    }

    # Symbolic link to the "latest" version directory
    my $headlink = File::Spec->catfile ($dest, $dir, 'latest');
    my $headrev  = 0;
    for my $rev (keys %versions) {
      $headrev = $rev if $rev > $headrev;
    }

    if (-l $headlink) {
      # Remove old symbolic link if there is no revision to update or if it
      # does not point to the correct version directory
      my $org = readlink $headlink;
      unlink $headlink if (! $headrev or $org ne $headrev);
    }

    # (Re-)create the "latest" symbolic link, if necessary
    symlink $headrev, $headlink if ($headrev and not -l $headlink);
  }

  $date = localtime;
  print $this, ': finished normally on ', $date, "\n";
}

__END__

=head1 NAME

fcm_update_version_dir.pl

=head1 SYNOPSIS

    fcm_update_version_dir.pl [OPTIONS] [CFGFILE]

=head1 DESCRIPTION

Update the version directories for a list of relative paths in the source
repository URL.

=head1 OPTIONS

=over 4

=item --dest=DEST, -d DEST

Specify a destination for the extraction. If not specified, the command extracts
to the current working directory.

=item --help, -h

Print help and exit.

=item --full, -f

Specify the full mode. If not specified, the command runs in incremental mode.

=item --url=URL, -u URL

Specify the source repository URL. No default.

=back

=head1 ARGUMENTS

A configuration file may be given to this command, or it will attempt to read
from the standard input. Each line in the configuration must contain a relative
path that resides under the given source repository URL. (Empty lines and lines
beginning with a "#" are ignored.) Optionally, each relative path may be
followed by a list of space separated "conditions".  Each condition is a
conditional operator (>, >=, <, <=, == or !=) followed by a revision number or
the keyword HEAD. The command uses the revision log to determine the revisions
at which the relative path has been updated in the source repository URL. If
these revisions also satisfy the "conditions" set by the user, they will be
considered in the extraction.  In full mode, everything is re-extracted. In
incremental mode, the version directories are only updated if they do not
already exist.

=head1 COPYRIGHT

(C) Crown copyright Met Office. All rights reserved.

=cut