source: XIOS/tools/FCM/examples/svn-hooks/pre-revprop-change.pl

Last change on this file was 81, checked in by ymipsl, 12 years ago

ajout FCM 1.5

File size: 6.5 KB
Line 
1#!/usr/bin/perl
2# ------------------------------------------------------------------------------
3# NAME
4#   pre-revprop-change.pl
5#
6# SYNOPSIS
7#   pre-revprop-change.pl REPOS REV USER PROPNAME ACTION <&0
8#
9# DESCRIPTION
10#   This script e-mails authors and watchers when a user attempts to modify the
11#   svn:log of a particular revision. The new property value is passed via
12#   STDIN. Watchers are set in the "watch.cfg" file, which should be located in
13#   the root within the Subversion repository. The watch.cfg file is a standard
14#   INI-type configuration file with the basic format:
15#
16#     [repos_base]
17#     path/in/repos = list,of,watchers
18#
19#   E.g.:
20#
21#     [FCM_svn]
22#
23#     FCM/trunk/src            = fcm,frsn
24#     FCM/trunk/doc            = fcm,frsn,frdm,frbj
25#     FCM/branches/dev/*/*/src = fcm,frsn
26#     FCM/branches/dev/*/*/doc = fcm,frsn,frdm,frbj
27#
28# COPYRIGHT
29#   (C) Crown copyright Met Office. All rights reserved.
30#   For further details please refer to the file COPYRIGHT.txt
31#   which you should have received as part of this distribution.
32# ------------------------------------------------------------------------------
33
34use strict;
35use warnings;
36
37use File::Basename;
38use File::Spec;
39use File::Temp qw/tempfile/;
40use Mail::Mailer;
41use Config::IniFiles;
42
43# Arguments
44# ------------------------------------------------------------------------------
45my ($repos, $rev, $user, $propname, $action) = @ARGV;
46
47# Basename of repository
48my $base = basename $repos;
49
50# Top level variables
51# ------------------------------------------------------------------------------
52# The watch configuration file, at the root of the current repository
53my $watch_config = 'watch.cfg';
54
55# Determine whether change is permitted
56# ------------------------------------------------------------------------------
57# Switch off for most revision properties
58my $return = 1;
59
60# Switch on only for "svn:log"
61$return = 0 if $propname eq 'svn:log' and $action eq 'M';
62
63if ($return == 0) {
64  # Diagnostic
65  print $repos, ': ', $propname, ' at revision ', $rev,
66        ' is being modified by ', $user, '.', "\n";
67
68  my %mail_to = ();
69
70  # Mail original author, if he/she is not the current user
71  # ----------------------------------------------------------------------------
72  # Find out who is the author of the changeset at $rev
73  my @command = (qw/svnlook author -r/, $rev, $repos);
74  my $author  = qx(@command);
75  chomp $author;
76
77  # Add author to mail list, if necessary
78  $mail_to{$author} = 1 if $author ne $user;
79
80  # Mail watchers, if changeset involves files being watched
81  # ----------------------------------------------------------------------------
82  # Find out what files were involved in the changeset
83  @command    = (qw/svnlook changed -r/, $rev, $repos);
84  my @changed = qx(@command);
85
86  # Get list of watchers for current repository
87  my %watch = &get_watchers ();
88
89  for my $file (@changed) {
90    # Remove trailing line break and leading status
91    chomp $file;
92    $file = substr ($file, 4);
93
94    # Find out who are watching this file
95    my @watchers = &who_watch ($file, \%watch);
96
97    # If necessary, add watchers to list, unless he/she is the current user
98    for my $watcher (@watchers) {
99      $mail_to{$watcher} = 1 if $user ne $watcher;
100    }
101  }
102
103  # Send mail if necessary
104  # ----------------------------------------------------------------------------
105  if (keys %mail_to) {
106    # Old value of revision property
107    my @command = (qw/svnlook pg -r/, $rev, '--revprop', $repos, $propname);
108    my $oldval  = qx(@command);
109
110    # Addresses as a comma-separated list
111    my $address = join (',', sort keys %mail_to);
112
113    # Invoke a new Mail::Mailer object
114    my $mailer  = Mail::Mailer->new ();
115    $mailer->open ({
116      From    => 'my.name@somewhere.org',
117      To      => $address,
118      Subject => $base . '@' . $rev . ': ' . $propname . ' modified by ' . $user,
119    }) or die 'Cannot e-mail ', $address, ' (', $!, ')';
120
121    # Write the mail
122    # Old value
123    print $mailer <<EOF;
124Old value:
125----------
126$oldval
127
128New value:
129----------
130EOF
131
132    # New value from STDIN
133    print $mailer $_ while (<STDIN>);
134
135    # Send the mail
136    $mailer->close;
137
138    print 'Mail notification has been sent to ', $address, '.', "\n";
139
140  } else {
141    print 'No mail notification is required for this change.', "\n";
142  }
143}
144
145exit $return;
146
147# ------------------------------------------------------------------------------
148# SYNOPSIS
149#   %watch = &get_watchers ();
150#
151# DESCRIPTION
152#   From the list of watch configuration files, get a list of watched files and
153#   their watchers for the current repository. Returns the results in a hash
154#   containing the watched paths (keys) and their corresponding list of
155#   watchers (values, array references).
156# ------------------------------------------------------------------------------
157
158sub get_watchers {
159  my %watch;
160
161  # Get contents in watch file
162  my @command = (qw/svnlook cat/, $repos, $watch_config);
163  my @output  = qx(@command);
164
165  if (@output) {
166    # Write result to temporary file
167    my ($fh, $temp_file) = tempfile (UNLINK => 1);
168    print $fh @output;
169    close $fh;
170
171    # Parse the configuration
172    my $cfg = Config::IniFiles->new ('-file' => $temp_file);
173
174    # Check if current repository name exists in the configuration file
175    if ($cfg and $cfg->SectionExists ($base)) {
176      # The name of the parameter is a sub-path in the repository
177      # The value of the parameter is a comma-delimited list of the watchers
178      my $separator = '/';
179      for my $parameter ($cfg->Parameters ($base)) {
180        # Parameter may contain wildcards * and ?
181        $parameter =~ s#\*#[^$separator]*#g;
182        $parameter =~ s#\?#[^$separator]#g;
183
184        $watch{$parameter} = [split (/,/, $cfg->val ($base, $parameter))];
185      }
186    }
187  }
188
189  return %watch;
190}
191
192# ------------------------------------------------------------------------------
193# SYNOPSIS
194#   my @watchers = &who_watch ($file, \%watch);
195#
196# DESCRIPTION
197#   Using the %watch hash, determine who are the watchers watching $file.
198#   Returns the list of watchers.
199# ------------------------------------------------------------------------------
200
201sub who_watch {
202  my $file  = $_[0];
203  my %watch = %{ $_[1] };
204
205  my %watchers;
206  my $separator = '/';
207
208  for my $watched (keys %watch) {
209    # Test if $file or its parent path is being watched
210    next unless $file =~ m#^$watched(?:$separator+|$)#;
211
212    # Add watchers to the return list
213    $watchers{$_} = 1 for (@{ $watch{$watched} });
214  }
215
216  return keys %watchers;
217}
218
219# ------------------------------------------------------------------------------
220
221__END__
Note: See TracBrowser for help on using the repository browser.