#!/usr/bin/env perl

use strict;



my $svnlook = "/usr/local/bin/svnlook";

die unless @ARGV == 2;

my $txn = shift;

my $repos = shift;

my (@addedtag, @usedtag);



open(LOG, ">/tmp/loglog.log") or die;

open(HD, "$svnlook changed -t $txn $repos|") or die;

while ($_ = <HD>) {

chomp;

# print LOG "$_

";

if (m/^([ADU ])[U ][ \t]+tags\/(.*)$/) {

my ($op, $path) = ($1, $2);

print LOG "$op / $path

";

if ($op eq 'A' && $path =~ m|^([^/]+)/$|) {

my $tag = $1;

print LOG "new tag $tag

";

push(@addedtag, $path);

}elsif ($path =~ m|^([^/]+)/|) {

my $utag = $1;

print LOG "$utag tagged file $path

";

push(@usedtag, $path);

}

}

}

close(HD);



my $files_not_allowed;

foreach my $p ( @usedtag ) {

print LOG "ckecking $p

";

my $allowed = 0;

foreach my $tag ( @addedtag ) {

if (substr($p, 0, length($tag)) eq $tag) {

$allowed = 1;

print LOG "$p allowed by $tag

";

next;

}

}

if (! $allowed) {

$files_not_allowed .= "$p ";

print LOG "not allowed: $p

";

}

}

close(LOG);



if (length($files_not_allowed) > 0) {

print STDERR "files below are operated under existing tag.

";

print STDERR "$files_not_allowed

";

exit 1;

}



exit 0;

一度作った tag で更新の commit が行われるのを禁止したかったのでちょっとスクリプト作成。ぐぐると http://tortoisesvn.tigris.org/servlets/ReadMsg?listName=dev&msgNo=21153 にそういう感じのがあるんですが、見た感じ、tags/ の下には add か delete しか絶対に許さないよ！っていうだけに見えるので、作った tag の下にファイルの追加だけして commit は通ってしまうんじゃないかと思って自作。やっつけなので結構きたないですが、実際に判別する perl script。tags/なんとか/ が add されたトランザクションの時に限り、 tags/なんとか/ 以下の操作を許可するが、それ以外の tags/かんとか 以下に対する操作があったら怒ります。適当に kick-tag-update.pl とか名付けました。

そして hooks/pre-commit に追加。

$REPOS/hooks/kick-tag-update.pl "$TXN" "$REPOS" || exit 1

ちなみに、空っぽもしくはそれに近いコミットログを蹴るのも適当に作成。