source: LMDZ6/branches/LMDZ-QUEST/tools/fcm/lib/Fcm/ReposBranch.pm @ 5321

Last change on this file since 5321 was 1578, checked in by jghattas, 13 years ago
  • Add fcm in LMDZ5/tools directory

It is no longer needed to have fcm in your environement PATH variable.
Now makelmdz_fcm takes by default this fcm. It is still possible to use
another fcm, using -fcm_path argument in makelmdz_fcm.
File size: 14.1 KB
Line 
1#!/usr/bin/perl
2# ------------------------------------------------------------------------------
3# NAME
4#   Fcm::ReposBranch
5#
6# DESCRIPTION
7#   This class contains methods for gathering information for a repository
8#   branch. It currently supports Subversion repository and local user
9#   directory.
10#
11# COPYRIGHT
12#   (C) Crown copyright Met Office. All rights reserved.
13#   For further details please refer to the file COPYRIGHT.txt
14#   which you should have received as part of this distribution.
15# ------------------------------------------------------------------------------
16
17package Fcm::ReposBranch;
18
19# Standard pragma
20use warnings;
21use strict;
22
23# Standard modules
24use Carp;
25use File::Spec;
26use File::Spec::Functions;
27use File::Basename;
28use File::Find;
29
30# FCM component modules
31use Fcm::Util;
32use Fcm::Timer;
33
34# ------------------------------------------------------------------------------
35# SYNOPSIS
36#   $branch = Fcm::ReposBranch->new (
37#     CONFIG  => $config,
38#     PACKAGE => $package,
39#     TAG     => $tag,
40#     REPOS   => $repos,
41#     VERSION => $version,
42#     TYPE    => $type,
43#   );
44#
45# DESCRIPTION
46#   This method constructs a new instance of the Fcm::ReposBranch class.
47#
48# ARGUMENTS
49#   CONFIG  - reference to a Fcm::Config instance
50#   PACKAGE - package name of which this repository belongs
51#   TAG     - "tag" name of this branch of the repository
52#   REPOS   - repository branch root URL/path
53#   VERSION - this version of the branch is used by the extract
54#   TYPE    - repository type
55# ------------------------------------------------------------------------------
56
57sub new {
58  my $this  = shift;
59  my %args  = @_;
60  my $class = ref $this || $this;
61
62  my $self = {
63    CONFIG  => (exists $args{CONFIG}  ? $args{CONFIG}  : &main::cfg),
64    PACKAGE => (exists $args{PACKAGE} ? $args{PACKAGE} : undef),
65    TAG     => (exists $args{TAG}     ? $args{TAG}     : undef),
66    REPOS   => (exists $args{REPOS}   ? $args{REPOS}   : undef),
67    VERSION => (exists $args{VERSION} ? $args{VERSION} : undef),
68    TYPE    => (exists $args{TYPE}    ? $args{TYPE}    : undef),
69
70    # Use this list of directories in this branch
71    DIRS    => {},
72
73    # Expand this list of directories in this branch
74    EXPDIRS => {},
75  };
76
77  bless $self, $class;
78  return $self;
79}
80
81# ------------------------------------------------------------------------------
82# SYNOPSIS
83#   $config = $branch->config;
84#
85# DESCRIPTION
86#   This method returns a reference to the Fcm::Config instance.
87# ------------------------------------------------------------------------------
88
89sub config {
90  my $self = shift;
91
92  return $self->{CONFIG};
93}
94
95# ------------------------------------------------------------------------------
96# SYNOPSIS
97#   $package = $branch->package;
98#   $branch->package ($package);
99#
100# DESCRIPTION
101#   This method returns the package name of this repository branch. If an
102#   argument is specified, the name is set to the value of the argument.
103# ------------------------------------------------------------------------------
104
105sub package {
106  my $self = shift;
107
108  if (@_) {
109    $self->{PACKAGE} = shift;
110  }
111
112  return $self->{PACKAGE};
113}
114
115# ------------------------------------------------------------------------------
116# SYNOPSIS
117#   $tag = $branch->tag;
118#   $branch->tag ($tag);
119#
120# DESCRIPTION
121#   This method returns the tag name of this repository branch. If an
122#   argument is specified, the name is set to the value of the argument.
123# ------------------------------------------------------------------------------
124
125sub tag {
126  my $self = shift;
127
128  if (@_) {
129    $self->{TAG} = shift;
130  }
131
132  return $self->{TAG};
133}
134
135# ------------------------------------------------------------------------------
136# SYNOPSIS
137#   $repos = $branch->repos;
138#   $branch->repos ($repos);
139#
140# DESCRIPTION
141#   This method returns the URL/path name of this repository branch. If an
142#   argument is specified, the URL/path is set to the value of the argument.
143# ------------------------------------------------------------------------------
144
145sub repos {
146  my $self = shift;
147
148  if (@_) {
149    $self->{REPOS} = shift;
150  }
151
152  return $self->{REPOS};
153}
154
155# ------------------------------------------------------------------------------
156# SYNOPSIS
157#   $version= $branch->version;
158#   $branch->version ($version);
159#
160# DESCRIPTION
161#   This method returns the revision number of this repository branch. If an
162#   argument is specified, the revision is set to the value of the argument.
163# ------------------------------------------------------------------------------
164
165sub version {
166  my $self = shift;
167
168  if (@_) {
169    $self->{VERSION} = shift;
170  }
171
172  return $self->{VERSION};
173}
174
175# ------------------------------------------------------------------------------
176# SYNOPSIS
177#   $type = $branch->type;
178#   $branch->type ($type);
179#
180# DESCRIPTION
181#   This method returns the repository type ("svn" or "user"). If an
182#   argument is specified, the type is set to the value of the argument.
183# ------------------------------------------------------------------------------
184
185sub type {
186  my $self = shift;
187
188  if (@_) {
189    $self->{TYPE} = shift;
190  }
191
192  return $self->{TYPE};
193}
194
195# ------------------------------------------------------------------------------
196# SYNOPSIS
197#   $dir = $branch->dir ($name);
198#   $branch->dir ($name, $dir);
199#
200# DESCRIPTION
201#   This method returns the path to the source directory with sub-package name
202#   $name. If $dir is specified, the path is set to its value.
203# ------------------------------------------------------------------------------
204
205sub dir {
206  my $self = shift;
207  my $name = shift;
208
209  if (@_) {
210    $self->{DIRS}{$name} = $_[0];
211  }
212
213  if (exists $self->{DIRS}{$name}) {
214    return $self->{DIRS}{$name};
215
216  } else {
217    return undef;
218  }
219}
220
221# ------------------------------------------------------------------------------
222# SYNOPSIS
223#   %dirs = $branch->dirs;
224#
225# DESCRIPTION
226#   This method returns a hash containing the source directories of this
227#   repository. The keys of the hash are the sub-package names, and the values
228#   of the hash are the URL/path to the source directories.
229# ------------------------------------------------------------------------------
230
231sub dirs {
232  my $self = shift;
233
234  return %{ $self->{DIRS} };
235}
236
237# ------------------------------------------------------------------------------
238# SYNOPSIS
239#   $dir = $branch->expdir ($name);
240#   $branch->expdir ($name, $dir);
241#
242# DESCRIPTION
243#   This method returns the path to the expandable source directory with
244#   sub-package name $name. If $dir is specified, the path is set to its
245#   value.
246# ------------------------------------------------------------------------------
247
248sub expdir {
249  my $self = shift;
250  my $name = shift;
251
252  if (@_) {
253    $self->{EXPDIRS}{$name} = $_[0];
254  }
255
256  if (exists $self->{EXPDIRS}{$name}) {
257    return $self->{EXPDIRS}{$name};
258
259  } else {
260    return undef;
261  }
262}
263
264# ------------------------------------------------------------------------------
265# SYNOPSIS
266#   %dirs = $branch->expdirs;
267#
268# DESCRIPTION
269#   This method returns a hash containing the expandable source directories of
270#   this repository. The keys of the hash are the sub-package names, and the
271#   values of the hash are the URL/path to the expandable source directories.
272# ------------------------------------------------------------------------------
273
274sub expdirs {
275  my $self = shift;
276
277  return %{ $self->{EXPDIRS} };
278}
279
280# ------------------------------------------------------------------------------
281# SYNOPSIS
282#   $branch->expand_version_tag;
283#
284# DESCRIPTION
285#   This method expands the VERSION of the current repository branch to a
286#   revision number.
287# ------------------------------------------------------------------------------
288
289sub expand_version_tag {
290  my $self = shift;
291
292  if ($self->type eq 'svn') {
293    # Expand revision keyword
294    my $rev = expand_rev_keyword (
295      REV  => $self->version,
296      URL  => $self->repos,
297      HEAD => 1,
298    );
299
300    # Find out whether the specified revision is current or not
301    if (uc ($self->version) ne 'HEAD' and $self->config->verbose > 1) {
302      # Get last commit revision
303      my $lc_rev = expand_rev_keyword (
304        REV => 'HEAD',
305        URL => $self->repos,
306      );
307
308      # Print information if used rev is less than the last commit rev
309      print 'Info: using rev ', $rev, ' of ', $self->repos,
310            ', last commit rev is ', $lc_rev, ".\n"
311        if $rev < $lc_rev;
312    }
313
314    $self->version ($rev) if $rev ne $self->version;
315
316  } elsif ($self->type eq 'user') {
317    return;
318
319  } else {
320    e_report $self->repos, ': repository type "', $self->type,
321             '" not supported.';
322  }
323}
324
325# ------------------------------------------------------------------------------
326# SYNOPSIS
327#   $branch->expand_path;
328#
329# DESCRIPTION
330#   This method expands the relative path names of sub-directories to full
331#   path names. It returns 1 on success.
332# ------------------------------------------------------------------------------
333
334sub expand_path {
335  my $self = shift;
336
337  my $separator = $self->{CONFIG}->setting (qw/MISC DIR_SEPARATOR/);
338
339  if ($self->type eq 'svn') {
340    # SVN repository
341    # Do nothing unless there is a declared repository for this branch
342    return unless $self->{REPOS};
343
344    # Remove trailing /
345    $self->{REPOS} =~ s/$separator+$//;
346
347    # Consider all declared (expandable) sub-directories
348    for my $name (qw/DIRS EXPDIRS/) {
349      for my $dir (keys %{ $self->{$name} }) {
350        # Do nothing if declared sub-directory is quoted as a full URL
351        next if &is_url ($self->{$name}{$dir});
352
353        # Expand sub-directory to full URL
354        $self->{$name}{$dir} = $self->{REPOS} . (
355          $self->{$name}{$dir} ? ($separator . $self->{$name}{$dir}) : ''
356        );
357      }
358    }
359    # Note: "catfile" cannot be used in the above statement because it has
360    #       the tendency of removing a slash from double slashes.
361
362  } elsif ($self->type eq 'user') {
363    # Local user directories
364
365    # Expand leading ~ for all declared (expandable) sub-directories
366    for my $name (qw/DIRS EXPDIRS/) {
367      for my $dir (keys %{ $self->{$name} }) {
368        $self->{$name}{$dir} = expand_tilde $self->{$name}{$dir};
369      }
370    }
371
372    # A top directory for the source is declared
373    if ($self->{REPOS}) {
374      # Expand leading ~ for the top directory
375      $self->{REPOS} = expand_tilde $self->{REPOS};
376
377      # Get the root directory of the file system
378      my $rootdir = File::Spec->rootdir ();
379
380      # Expand top directory to absolute path, if necessary
381      $self->{REPOS} = File::Spec->rel2abs ($self->{REPOS})
382        if $self->{REPOS} !~ m/^$rootdir/;
383
384      # Remove trailing /
385      $self->{REPOS} =~ s/$separator+$//;
386
387      # Consider all declared (expandable) sub-directories
388      for my $name (qw/DIRS EXPDIRS/) {
389        for my $dir (keys %{ $self->{$name} }) {
390          # Do nothing if declared sub-directory is quoted as a full path
391          next if $self->{$name}{$dir} =~ m#^$rootdir#;
392
393          # Expand sub-directory to full path
394          $self->{$name}{$dir} = $self->{$name}{$dir}
395                               ? catfile ($self->{REPOS}, $self->{$name}{$dir})
396                               : $self->{REPOS};
397        }
398      }
399    }
400
401  } else {
402    e_report $self->repos, ': repository type "', $self->type,
403             '" not supported.';
404  }
405
406  return 1;
407}
408
409# ------------------------------------------------------------------------------
410# SYNOPSIS
411#   $branch->expand_all;
412#
413# DESCRIPTION
414#   This method searches the expandable source directories recursively for
415#   source directories containing regular files. These sub-directories are
416#   then added to the source directory list. The method returns total number
417#   of sub-directories to be extracted from the current repository.
418# ------------------------------------------------------------------------------
419
420sub expand_all {
421  my $self = shift;
422
423  my %dirs = ();
424
425  # Directory separator for SVN repository
426  my $separator = $self->{CONFIG}->setting (qw/MISC DIR_SEPARATOR/);
427
428  if ($self->type eq 'user') {
429    for my $rootname (keys %{ $self->{EXPDIRS} }) {
430      my %subdirs = find_srcdir $self->{EXPDIRS}{$rootname}, $rootname, '::';
431
432      for my $key (keys %subdirs) {
433        $dirs{$key} = $subdirs{$key};
434      }
435    }
436
437  } elsif  ($self->type eq 'svn') {
438    for my $rootname (keys %{ $self->{EXPDIRS} }) {
439      # Execute the "svn ls -R" command
440      my @lines   = &run_command (
441        [qw/svn ls -R/, $self->{EXPDIRS}{$rootname} . '@' . $self->{VERSION}],
442        METHOD => 'qx', TIME => $self->config->verbose > 2,
443      );
444
445      # Get list of sub-directories containing source files
446      for my $line (@lines) {
447        chomp $line;
448        next if $line =~ /$separator$/;
449
450        my $dir = dirname $line;
451
452        my @pck = split /::/, $rootname;
453        push @pck, (File::Spec->splitdir ($dir)) unless $dir eq '.';
454        my $pck = join '::', @pck;
455
456        my $val = $self->{EXPDIRS}{$rootname};
457        $val   .= $separator . $dir unless $dir eq '.';
458
459        $dirs{$pck} = $val;
460      }
461    }
462
463  } else {
464    e_report $self->repos, ': repository type "', $self->type,
465             '" not supported.';
466  }
467
468  for my $key (keys %dirs) {
469    $self->{DIRS}{$key} = $dirs{$key};
470  }
471
472  return scalar keys %dirs;
473}
474
475# ------------------------------------------------------------------------------
476# SYNOPSIS
477#   $branch->add_base_dirs ($base);
478#
479# DESCRIPTION
480#   Add a list of source directories to the current branch based on the set
481#   provided by $base, which must be a reference to a Fcm::ReposBranch
482#   instance. It returns the total number of used sub-directories in the
483#   current repositories.
484# ------------------------------------------------------------------------------
485
486sub add_base_dirs {
487  my $self = shift;
488  my $base = shift;
489
490  my %base_dirs = $base->dirs;
491
492  for my $key (keys %base_dirs) {
493    # Remove repository root from base directories
494    if ($base_dirs{$key} eq $base->repos) {
495      $base_dirs{$key} = '';
496
497    } else {
498      $base_dirs{$key} = substr $base_dirs{$key}, length ($base->repos) + 1;
499    }
500
501    # Append base directories to current repository root
502    $self->dir ($key, $base_dirs{$key}); 
503  }
504
505  # Expand relative path names of sub-directories
506  $self->expand_path;
507
508  return scalar keys %{ $self->{DIRS} };
509 
510}
511
512# ------------------------------------------------------------------------------
513
5141;
515
516__END__
Note: See TracBrowser for help on using the repository browser.