#!/usr/bin/perl # ------------------------------------------------------------------------------ # (C) British Crown Copyright 2006-17 Met Office. # # This file is part of FCM, tools for managing and building source code. # # FCM is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # FCM is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with FCM. If not, see . # ------------------------------------------------------------------------------ use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use FCM::Admin::System qw{get_users}; use FCM::System::CM::SVN; use FCM::Util; use Text::ParseWords qw{shellwords}; our @IGNORES = qw{Config Rel Share}; my $UTIL = FCM::Util->new(); my $CM_SYS = FCM::System::CM::SVN->new({'util' => $UTIL}); if (!caller()) { main(@ARGV); } sub main { local(@ARGV) = @_; my ($repos, $rev, $txn) = @ARGV; my %layout_config = $CM_SYS->load_layout_config('file://' . $repos); if (!$layout_config{'level-owner-branch'} && !$layout_config{'owner'}) { return; } my @owners; if (open(my $handle, "$repos/hooks/commit.conf")) { COMMIT_CONF_LINE: while (my $line = readline($handle)) { chomp($line); my ($owners_str) = $line =~ qr{\A\s*owner\s*=\s*(.*)\z}msx; if ($owners_str) { @owners = shellwords($owners_str); last COMMIT_CONF_LINE; } } close($handle); } my ($author) = $CM_SYS->stdout(qw{svnlook author -r}, $rev, $repos); # Get list of new paths my %branches = (); # {$project/$branch1 => 1, $project/$branch2 => 1, ...} my %names = (); # {$name1 => 1, $name2 => 1, ...} my @lines = $CM_SYS->stdout(qw{svnlook changed -r}, $rev, $repos); CHANGED_LINE: for my $line (@lines) { my $status = substr($line, 0, 1); my $path = substr($line, 4); my $layout = $CM_SYS->get_layout_common( $repos, ($status eq 'D' ? $rev - 1 : $rev), '/' . $path, # must start with a '/' 1, # $is_local=1 ); my $project = $layout->get_project(); my $branch = $layout->get_branch(); if (!$branch || exists($branches{"$project/$branch"})) { next CHANGED_LINE; } $branches{"$project/$branch"} = 1; # so we only do each branch once if (@owners && $layout->is_trunk()) { for my $owner (grep {$_ ne $author} @owners) { $names{$owner} = 1; } } elsif ($layout->is_branch()) { my $owner = $layout->get_branch_owner(); if (!$owner || $layout->is_shared()) { # If owner is not in the branch name, # assume owner is branch creator my $url = 'file://' . $layout->get_root(); if ($project) { $url .= '/' . $project; } $url .= '/' . $branch . '@' . $rev; my @lines = $CM_SYS->stdout( qw{svn log -q --incremental --stop-on-copy --limit 1}, '-r1:' . $rev, $url, ); LOG_LINE: for my $line (reverse(@lines)) { ($owner) = $line =~ qr{\Ar\d+\s\|\s([^\|]+)\s\|}msx; if ($owner) { last LOG_LINE; } } } if ($owner && $owner ne $author) { $names{$owner} = 1; } } } # Get emails, if necessary if (%names) { local($FCM::Admin::System::UTIL) = $UTIL; my @names = ($author, keys(%names)); my @emails = sort grep {$_} map {$_->get_email()} values(%{get_users(@names)}); print(join(q{,}, @emails) . "\n"); } } 1; __END__ =head1 NAME post-commit-bg-notify-who =head1 SYNOPSIS post-commit-bg-notify-who $REPOS $REV $TXN =head1 ARGUMENTS Accept the same arguments as a Subversion post-commit hook. =head1 DESCRIPTION This program prints email addresses who should be notified of the change. E.g. If this commit is performed by an author on someone else's branch. =head1 COPYRIGHT E<169> Crown copyright Met Office. All rights reserved. =cut