source: LMDZ5/branches/testing/tools/fcm/templates/hook/pre-revprop-change.pl @ 3276

Last change on this file since 3276 was 1665, checked in by Laurent Fairhead, 12 years ago

Version testing basée sur la r1628

http://lmdz.lmd.jussieu.fr/utilisateurs/distribution-du-modele/versions-intermediaires


Testing release based on r1628

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