New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
fcm_update_version_dir.pl in branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/EXTERNAL/fcm/bin – NEMO

source: branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/EXTERNAL/fcm/bin/fcm_update_version_dir.pl @ 5733

Last change on this file since 5733 was 5733, checked in by jpalmier, 9 years ago

JPALM --11-09-2015 -- remove svn keyword

File size: 8.2 KB
Line 
1#!/usr/bin/env perl
2#-------------------------------------------------------------------------------
3# (C) Crown copyright Met Office. All rights reserved.
4# For further details please refer to the file COPYRIGHT.txt
5# which you should have received as part of this distribution.
6#-------------------------------------------------------------------------------
7
8use strict;
9use warnings;
10
11use FindBin;
12use lib "$FindBin::Bin/../lib";
13use Cwd qw{cwd};
14use Getopt::Long qw{GetOptions};
15use Fcm::Config;
16use Fcm::Keyword;
17use Fcm::Util qw{get_url_of_wc get_wct is_wc run_command tidy_url};
18use File::Basename qw{basename dirname};
19use File::Path qw{mkpath};
20use File::Spec;
21use Pod::Usage qw{pod2usage};
22
23# Usage
24# ------------------------------------------------------------------------------
25my $this  = basename($0);
26
27# Options
28# ------------------------------------------------------------------------------
29my ($dest, $full, $help, $url);
30my $rc = GetOptions(
31  'dest|d=s' => \$dest,
32  'full|f'   => \$full,
33  'help'     => \$help,
34  'url|u=s'  => \$url,
35);
36if (!$rc) {
37  pod2usage({'-verbose' => 1});
38}
39if ($help) {
40  pod2usage({'-exitval' => 0, '-verbose' => 1});
41}
42if (!$url) {
43  pod2usage(
44    {'-message' => 'The --url=URL option is compulsory', '-verbose' => 1},
45  );
46}
47$dest ||= cwd();
48
49# Arguments
50# ------------------------------------------------------------------------------
51if (@ARGV) {
52  die 'Cannot read: ', $ARGV[0], ', abort' unless -f $ARGV[0] and -r $ARGV[0];
53}
54
55# Get configuration settings
56# ------------------------------------------------------------------------------
57my $config = Fcm::Config->new ();
58$config->get_config ();
59
60# Expand URL keyword
61$url = Fcm::Util::tidy_url(Fcm::Keyword::expand($url));
62
63# ------------------------------------------------------------------------------
64
65MAIN: {
66  my $date = localtime;
67  print $this, ': started on ', $date, "\n";
68
69  my %dirs;
70
71  # Read input (file) for a list directories and update conditions
72  while (<>) {
73    chomp;
74
75    # Ignore empty and comment lines
76    next if /^\s*(?:#|$)/;
77
78    # Each line must contain a relative path, and optionally a list of
79    # space delimited conditions
80    my @words = split /\s+/;
81    my $dir   = shift @words;
82
83    # Check that the conditions are valid
84    my @conditions;
85    for my $word (@words) {
86      if ($word =~ /^([<>]=?|[!=]=)(.+)$/i) {
87        # Condition must be a conditional operator followed by a revision
88        my ($operator, $rev) = ($1, $2);
89        $rev = (Fcm::Keyword::expand($url, $rev))[1];
90        push @conditions, $operator . $rev;
91
92      } else {
93        print STDERR 'Warning: ignore unknown syntax for update condition: ',
94                     $word, "\n";
95      }
96    }
97
98    # Add directory and its conditions to a hash
99    if ($dir =~ s#/\*$##) { # Directory finishes with wildcard
100
101      # Run "svn ls" in recursive mode
102      my $dirurl  = join ('/', ($url, $dir));
103      my @files   = &run_command ([qw/svn ls -R/, $dirurl], METHOD => 'qx');
104
105      # Find directories containing regular files
106      while (my $file = shift @files) {
107   # Skip directories
108   next if $file =~ m#/$#;
109
110   # Get "dirname" of regular file and add to hash
111   my $subdir = join ('/', ($dir, dirname ($file)));
112   $dirs{$subdir} = \@conditions;
113      }
114
115    } else {
116      $dirs{$dir} = \@conditions;
117    }
118
119  }
120
121  # Update each directory, if required
122  for my $dir (sort keys %dirs) {
123    # Use "svn log" to determine the revisions that need to be updated
124    my %allversions;
125    {
126      my $command = 'svn log -q ' . join ('/', ($url, $dir));
127      my @log     = &run_command (
128        [qw/svn log -q/, join ('/', ($url, $dir))], METHOD => 'qx',
129      );
130      @log        = grep /^r\d+/, @log;
131
132      # Assign a sequential "version" number to each sub-directory
133      my $version = scalar @log;
134      for (@log) {
135        m/^r(\d+)/;
136        $allversions{$1} = 'v' . $version--;
137      }
138    }
139    my %versions = %allversions;
140
141    # Extract only revisions matching the conditions
142    if (@{ $dirs{$dir} }) {
143      my @conditions = @{ $dirs{$dir} };
144
145      for my $condition (@conditions) {
146        for my $rev (keys %versions) {
147          delete $versions{$rev} unless eval ($rev . $condition);
148        }
149      }
150    }
151
152    # Destination directory
153    my $dirpath = File::Spec->catfile ($dest, $dir);
154
155    if (-d $dirpath) {
156      if ($full or not keys %versions) {
157        # Remove destination directory top, in full mode
158        # or if there are no matching revisions
159        &run_command ([qw/rm -rf/, $dirpath], PRINT => 1);
160
161      } else {
162        # Delete excluded revisions if they exist, in incremental mode
163        if (opendir DIR, $dirpath) {
164          while (my $rev = readdir 'DIR') {
165            next unless $rev =~ /^\d+$/;
166
167            if (not grep {$_ eq $rev} keys %versions) {
168              my @command = (qw/rm -rf/, File::Spec->catfile ($dirpath, $rev));
169              &run_command (\@command, PRINT => 1);
170
171              # Remove "version" symlink
172              my $verlink = File::Spec->catfile ($dirpath, $allversions{$rev});
173              unlink $verlink if -l $verlink;
174            }
175          }
176          closedir DIR;
177        }
178      }
179    }
180
181    # Create container directory of destination if it does not already exist
182    if (keys %versions and not -d $dirpath) {
183      print '-> mkdir -p ', $dirpath, "\n";
184      my $rc = mkpath $dirpath;
185      die 'mkdir -p ', $dirpath, ' failed' unless $rc;
186    }
187
188    # Update each version directory that needs updating
189    for my $rev (keys %versions) {
190      my $revpath = File::Spec->catfile ($dest, $dir, $rev);
191
192      # Create version directory if it does not exist
193      if (not -e $revpath) {
194        # Use "svn export" to create the version directory
195        my @command = (
196          qw/svn export -q -r/,
197          $rev,
198          join ('/', ($url, $dir)),
199          $revpath,
200        );
201
202        &run_command (\@command, PRINT => 1);
203      }
204
205      # Create "version" symlink if necessary
206      my $verlink = File::Spec->catfile ($dest, $dir, $versions{$rev});
207      symlink $rev, $verlink unless -l $verlink;
208    }
209
210    # Symbolic link to the "latest" version directory
211    my $headlink = File::Spec->catfile ($dest, $dir, 'latest');
212    my $headrev  = 0;
213    for my $rev (keys %versions) {
214      $headrev = $rev if $rev > $headrev;
215    }
216
217    if (-l $headlink) {
218      # Remove old symbolic link if there is no revision to update or if it
219      # does not point to the correct version directory
220      my $org = readlink $headlink;
221      unlink $headlink if (! $headrev or $org ne $headrev);
222    }
223
224    # (Re-)create the "latest" symbolic link, if necessary
225    symlink $headrev, $headlink if ($headrev and not -l $headlink);
226  }
227
228  $date = localtime;
229  print $this, ': finished normally on ', $date, "\n";
230}
231
232__END__
233
234=head1 NAME
235
236fcm_update_version_dir.pl
237
238=head1 SYNOPSIS
239
240    fcm_update_version_dir.pl [OPTIONS] [CFGFILE]
241
242=head1 DESCRIPTION
243
244Update the version directories for a list of relative paths in the source
245repository URL.
246
247=head1 OPTIONS
248
249=over 4
250
251=item --dest=DEST, -d DEST
252
253Specify a destination for the extraction. If not specified, the command extracts
254to the current working directory.
255
256=item --help, -h
257
258Print help and exit.
259
260=item --full, -f
261
262Specify the full mode. If not specified, the command runs in incremental mode.
263
264=item --url=URL, -u URL
265
266Specify the source repository URL. No default.
267
268=back
269
270=head1 ARGUMENTS
271
272A configuration file may be given to this command, or it will attempt to read
273from the standard input. Each line in the configuration must contain a relative
274path that resides under the given source repository URL. (Empty lines and lines
275beginning with a "#" are ignored.) Optionally, each relative path may be
276followed by a list of space separated "conditions".  Each condition is a
277conditional operator (>, >=, <, <=, == or !=) followed by a revision number or
278the keyword HEAD. The command uses the revision log to determine the revisions
279at which the relative path has been updated in the source repository URL. If
280these revisions also satisfy the "conditions" set by the user, they will be
281considered in the extraction.  In full mode, everything is re-extracted. In
282incremental mode, the version directories are only updated if they do not
283already exist.
284
285=head1 COPYRIGHT
286
287(C) Crown copyright Met Office. All rights reserved.
288
289=cut
Note: See TracBrowser for help on using the repository browser.