290 lines
8.2 KiB
Perl
Executable File
290 lines
8.2 KiB
Perl
Executable File
#!/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
|