xref: /openbsd/gnu/usr.bin/cvs/contrib/log.in (revision 43c1707e) 
1#! @PERL@
2# -*-Perl-*-
3#
4# XXX: FIXME: handle multiple '-f logfile' arguments
5#
6# XXX -- I HATE Perl!  This *will* be re-written in shell/awk/sed soon!
7#
8
9# Usage:  log.pl [-u user] [[-m mailto] ...] [-s] [-V] -f logfile 'dirname file ...'
10#
11#	-u user		- $USER passed from loginfo
12#	-m mailto	- for each user to receive cvs log reports
13#			(multiple -m's permitted)
14#	-s		- to prevent "cvs status -v" messages
15#	-V		- without '-s', don't pass '-v' to cvs status
16#	-f logfile	- for the logfile to append to (mandatory,
17#			but only one logfile can be specified).
18
19# here is what the output looks like:
20#
21#    From: woods@kuma.domain.top
22#    Subject: CVS update: testmodule
23#
24#    Date: Wednesday November 23, 1994 @ 14:15
25#    Author: woods
26#
27#    Update of /local/src-CVS/testmodule
28#    In directory kuma:/home/kuma/woods/work.d/testmodule
29#
30#    Modified Files:
31#    	test3
32#    Added Files:
33#    	test6
34#    Removed Files:
35#    	test4
36#    Log Message:
37#    - wow, what a test
38#
39# (and for each file the "cvs status -v" output is appended unless -s is used)
40#
41#    ==================================================================
42#    File: test3           	Status: Up-to-date
43#
44#       Working revision:	1.41	Wed Nov 23 14:15:59 1994
45#       Repository revision:	1.41	/local/src-CVS/cvs/testmodule/test3,v
46#       Sticky Options:	-ko
47#
48#       Existing Tags:
49#    	local-v2                 	(revision: 1.7)
50#    	local-v1                 	(revision: 1.1.1.2)
51#    	CVS-1_4A2                	(revision: 1.1.1.2)
52#    	local-v0                 	(revision: 1.2)
53#    	CVS-1_4A1                	(revision: 1.1.1.1)
54#    	CVS                      	(branch: 1.1.1)
55
56use strict;
57use IO::File;
58
59my $cvsroot = $ENV{'CVSROOT'};
60
61# turn off setgid
62#
63$) = $(;
64
65my $dostatus = 1;
66my $verbosestatus = 1;
67my $users;
68my $login;
69my $donefiles;
70my $logfile;
71my @files;
72
73# parse command line arguments
74#
75while (@ARGV) {
76	my $arg = shift @ARGV;
77
78	if ($arg eq '-m') {
79		$users = "$users " . shift @ARGV;
80	} elsif ($arg eq '-u') {
81		$login = shift @ARGV;
82	} elsif ($arg eq '-f') {
83		($logfile) && die "Too many '-f' args";
84		$logfile = shift @ARGV;
85	} elsif ($arg eq '-s') {
86		$dostatus = 0;
87	} elsif ($arg eq '-V') {
88		$verbosestatus = 0;
89	} else {
90		($donefiles) && die "Too many arguments!\n";
91		$donefiles = 1;
92		@files = split(/ /, $arg);
93	}
94}
95
96# the first argument is the module location relative to $CVSROOT
97#
98my $modulepath = shift @files;
99
100my $mailcmd = "| Mail -s 'CVS update: $modulepath'";
101
102# Initialise some date and time arrays
103#
104my @mos = ('January','February','March','April','May','June','July',
105	'August','September','October','November','December');
106my @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
107
108my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
109$year += 1900;
110
111# get a login name for the guy doing the commit....
112#
113if ($login eq '') {
114	$login = getlogin || (getpwuid($<))[0] || "nobody";
115}
116
117# open log file for appending
118#
119my $logfh = new IO::File ">>" . $logfile
120	or die "Could not open(" . $logfile . "): $!\n";
121
122# send mail, if there's anyone to send to!
123#
124my $mailfh;
125if ($users) {
126	$mailcmd = "$mailcmd $users";
127	$mailfh = new IO::File $mailcmd
128		or die "Could not Exec($mailcmd): $!\n";
129}
130
131# print out the log Header
132#
133$logfh->print ("\n");
134$logfh->print ("****************************************\n");
135$logfh->print ("Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n");
136$logfh->print ("Author:\t$login\n\n");
137
138if ($mailfh) {
139	$mailfh->print ("\n");
140	$mailfh->print ("Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n");
141	$mailfh->print ("Author:\t$login\n\n");
142}
143
144# print the stuff from logmsg that comes in on stdin to the logfile
145#
146my $infh = new IO::File "< -";
147foreach ($infh->getlines) {
148	$logfh->print;
149	if ($mailfh) {
150		$mailfh->print ($_);
151	}
152}
153undef $infh;
154
155$logfh->print ("\n");
156
157# after log information, do an 'cvs -Qq status -v' on each file in the arguments.
158#
159if ($dostatus != 0) {
160	while (@files) {
161		my $file = shift @files;
162		if ($file eq "-") {
163			$logfh->print ("[input file was '-']\n");
164			if ($mailfh) {
165				$mailfh->print ("[input file was '-']\n");
166			}
167			last;
168		}
169		my $rcsfh = new IO::File;
170		my $pid = $rcsfh->open ("-|");
171		if ( !defined $pid )
172		{
173			die "fork failed: $!";
174		}
175		if ($pid == 0)
176		{
177			my @command = ('cvs', '-nQq', 'status');
178			if ($verbosestatus)
179			{
180				push @command, '-v';
181			}
182			push @command, $file;
183			exec @command;
184			die "cvs exec failed: $!";
185		}
186		my $line;
187		while ($line = $rcsfh->getline) {
188			$logfh->print ($line);
189			if ($mailfh) {
190				$mailfh->print ($line);
191			}
192		}
193		undef $rcsfh;
194	}
195}
196
197$logfh->close()
198	or die "Write to $logfile failed: $!";
199
200if ($mailfh)
201{
202	$mailfh->close;
203	die "Pipe to $mailcmd failed" if $?;
204}
205
206## must exit cleanly
207##
208exit 0;
209