1 | #!/usr/athena/bin/perl |
---|
2 | |
---|
3 | # In commitinfo, put: |
---|
4 | # ALL $CVSROOT/CVSROOT/record.pl $CVSROOT |
---|
5 | # In loginfo, put: |
---|
6 | # ALL $CVSROOT/CVSROOT/logfilter.pl %{sVv} commit-address diff-adddress |
---|
7 | |
---|
8 | # This script is invoked by cvs once per directory in the commit, with |
---|
9 | # the directory name as an argument. We record the first directory in |
---|
10 | # a file named "firstdir" and the last directory in a file named |
---|
11 | # "lastdir". |
---|
12 | |
---|
13 | use strict; |
---|
14 | use File::Spec::Functions; |
---|
15 | use File::stat; |
---|
16 | use Fcntl ':mode'; |
---|
17 | |
---|
18 | my ($cvsroot, $dir, $reldir, $tmpdir, $sb, $filename); |
---|
19 | |
---|
20 | # commitinfo gives us the directory with repository path, while |
---|
21 | # loginfo will give logfilter.pl the directory relative to the |
---|
22 | # repository. Chop off the repository part here so that we can |
---|
23 | # compare there. |
---|
24 | $cvsroot = $ARGV[0]; |
---|
25 | $cvsroot .= "/" unless ($cvsroot =~ /\/$/); |
---|
26 | $dir = $ARGV[1]; |
---|
27 | $reldir = substr($dir, length($cvsroot)); |
---|
28 | |
---|
29 | $tmpdir = "/tmp/athena-cvs-" . getpgrp(); |
---|
30 | if (! -e $tmpdir) { |
---|
31 | mkdir($tmpdir, 0755) || die("Can't mkdir $tmpdir: $!\n"); |
---|
32 | } |
---|
33 | $sb = lstat($tmpdir); |
---|
34 | if (!S_ISDIR($sb->mode) || ($sb->mode & (S_IWGRP|S_IWOTH)) || $sb->uid != $>) { |
---|
35 | die "Problem with temporary directory"; |
---|
36 | } |
---|
37 | |
---|
38 | # Record the first directory if that hasn't been done yet. |
---|
39 | $filename = catfile($tmpdir, "firstdir"); |
---|
40 | if (! -e $filename) { |
---|
41 | open(FILE, "> $filename") || die("Can't open $filename for writing: $!\n"); |
---|
42 | print FILE $reldir, "\n"; |
---|
43 | close(FILE); |
---|
44 | } |
---|
45 | |
---|
46 | # Record the last directory, overwriting previous settings of it. |
---|
47 | $filename = catfile($tmpdir, "lastdir"); |
---|
48 | open(FILE, "> $filename") || die("Can't open $filename for writing: $!\n"); |
---|
49 | print FILE $reldir, "\n"; |
---|
50 | close(FILE); |
---|