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.
post-commit-bg-notify-who in vendors/FCM-2017.10.0/sbin – NEMO

source: vendors/FCM-2017.10.0/sbin/post-commit-bg-notify-who @ 13905

Last change on this file since 13905 was 10672, checked in by nicolasmartin, 5 years ago

Reimport latest FCM release

File size: 4.7 KB
Line 
1#!/usr/bin/perl
2# ------------------------------------------------------------------------------
3# (C) British Crown Copyright 2006-17 Met Office.
4#
5# This file is part of FCM, tools for managing and building source code.
6#
7# FCM is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# FCM is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with FCM. If not, see <http://www.gnu.org/licenses/>.
19# ------------------------------------------------------------------------------
20
21use strict;
22use warnings;
23
24use FindBin;
25use lib "$FindBin::Bin/../lib";
26use FCM::Admin::System qw{get_users};
27use FCM::System::CM::SVN;
28use FCM::Util;
29use Text::ParseWords qw{shellwords};
30
31our @IGNORES = qw{Config Rel Share};
32
33my $UTIL = FCM::Util->new();
34my $CM_SYS = FCM::System::CM::SVN->new({'util' => $UTIL});
35
36if (!caller()) {
37    main(@ARGV);
38}
39
40sub main {
41    local(@ARGV) = @_;
42    my ($repos, $rev, $txn) = @ARGV;
43
44    my %layout_config = $CM_SYS->load_layout_config('file://' . $repos);
45    if (!$layout_config{'level-owner-branch'} && !$layout_config{'owner'}) {
46        return;
47    }
48
49    my @owners;
50    if (open(my $handle, "$repos/hooks/commit.conf")) {
51        COMMIT_CONF_LINE:
52        while (my $line = readline($handle)) {
53            chomp($line);
54            my ($owners_str) = $line =~ qr{\A\s*owner\s*=\s*(.*)\z}msx;
55            if ($owners_str) {
56                @owners = shellwords($owners_str);
57                last COMMIT_CONF_LINE;
58            }
59        }
60        close($handle);
61    }
62
63    my ($author) = $CM_SYS->stdout(qw{svnlook author -r}, $rev, $repos);
64
65    # Get list of new paths
66    my %branches = ();  # {$project/$branch1 => 1, $project/$branch2 => 1, ...}
67    my %names = (); # {$name1 => 1, $name2 => 1, ...}
68    my @lines = $CM_SYS->stdout(qw{svnlook changed -r}, $rev, $repos);
69    CHANGED_LINE:
70    for my $line (@lines) {
71        my $status = substr($line, 0, 1);
72        my $path = substr($line, 4);
73        my $layout = $CM_SYS->get_layout_common(
74            $repos,
75            ($status eq 'D' ? $rev - 1 : $rev),
76            '/' . $path, # must start with a '/'
77            1, # $is_local=1
78        );
79        my $project = $layout->get_project();
80        my $branch = $layout->get_branch();
81        if (!$branch || exists($branches{"$project/$branch"})) {
82            next CHANGED_LINE;
83        }
84        $branches{"$project/$branch"} = 1; # so we only do each branch once
85        if (@owners && $layout->is_trunk()) {
86            for my $owner (grep {$_ ne $author} @owners) {
87                $names{$owner} = 1;
88            }
89        }
90        elsif ($layout->is_branch()) {
91            my $owner = $layout->get_branch_owner();
92            if (!$owner || $layout->is_shared()) {
93                # If owner is not in the branch name,
94                # assume owner is branch creator
95                my $url = 'file://' . $layout->get_root();
96                if ($project) {
97                    $url .= '/' . $project;
98                }
99                $url .= '/' . $branch . '@' . $rev;
100                my @lines = $CM_SYS->stdout(
101                    qw{svn log -q --incremental --stop-on-copy --limit 1},
102                    '-r1:' . $rev,
103                    $url,
104                );
105                LOG_LINE:
106                for my $line (reverse(@lines)) {
107                    ($owner) = $line =~ qr{\Ar\d+\s\|\s([^\|]+)\s\|}msx;
108                    if ($owner) {
109                        last LOG_LINE;
110                    }
111                }
112            }
113            if ($owner && $owner ne $author) {
114                $names{$owner} = 1;
115            }
116        }
117    }
118
119    # Get emails, if necessary
120    if (%names) {
121        local($FCM::Admin::System::UTIL) = $UTIL;
122        my @names = ($author, keys(%names));
123        my @emails
124            = sort grep {$_} map {$_->get_email()} values(%{get_users(@names)});
125        print(join(q{,}, @emails) . "\n");
126    }
127}
128
1291;
130__END__
131
132=head1 NAME
133
134post-commit-bg-notify-who
135
136=head1 SYNOPSIS
137
138    post-commit-bg-notify-who $REPOS $REV $TXN
139
140=head1 ARGUMENTS
141
142Accept the same arguments as a Subversion post-commit hook.
143
144=head1 DESCRIPTION
145
146This program prints email addresses who should be notified of the change. E.g.
147If this commit is performed by an author on someone else's branch.
148
149=head1 COPYRIGHT
150
151E<169> Crown copyright Met Office. All rights reserved.
152
153=cut
Note: See TracBrowser for help on using the repository browser.