4 # XXX: FIXME: handle multiple '-f logfile' arguments
6 # XXX -- I HATE Perl! This *will* be re-written in shell/awk/sed soon!
9 # Usage: log.pl [-u user] [[-m mailto] ...] [-s] [-V] -f logfile 'dirname file ...'
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).
19 # here is what the output looks like:
21 # From: woods@kuma.domain.top
22 # Subject: CVS update: testmodule
24 # Date: Wednesday November 23, 1994 @ 14:15
27 # Update of /local/src-CVS/testmodule
28 # In directory kuma:/home/kuma/woods/work.d/testmodule
39 # (and for each file the "cvs status -v" output is appended unless -s is used)
41 # ==================================================================
42 # File: test3 Status: Up-to-date
44 # Working revision: 1.41 Wed Nov 23 14:15:59 1994
45 # Repository revision: 1.41 /local/src-CVS/cvs/testmodule/test3,v
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)
59 my $cvsroot = $ENV{'CVSROOT'};
66 my $verbosestatus = 1;
73 # parse command line arguments
76 my $arg = shift @ARGV;
79 $users = "$users " . shift @ARGV;
80 } elsif ($arg eq '-u') {
82 } elsif ($arg eq '-f') {
83 ($logfile) && die "Too many '-f' args";
84 $logfile = shift @ARGV;
85 } elsif ($arg eq '-s') {
87 } elsif ($arg eq '-V') {
90 ($donefiles) && die "Too many arguments!\n";
92 @files = split(/ /, $arg);
96 # the first argument is the module location relative to $CVSROOT
98 my $modulepath = shift @files;
100 my $mailcmd = "| Mail -s 'CVS update: $modulepath'";
102 # Initialise some date and time arrays
104 my @mos = ('January','February','March','April','May','June','July',
105 'August','September','October','November','December');
106 my @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
108 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
111 # get a login name for the guy doing the commit....
114 $login = getlogin || (getpwuid($<))[0] || "nobody";
117 # open log file for appending
119 my $logfh = new IO::File ">>" . $logfile
120 or die "Could not open(" . $logfile . "): $!\n";
122 # send mail, if there's anyone to send to!
126 $mailcmd = "$mailcmd $users";
127 $mailfh = new IO::File $mailcmd
128 or die "Could not Exec($mailcmd): $!\n";
131 # print out the log Header
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");
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");
144 # print the stuff from logmsg that comes in on stdin to the logfile
146 my $infh = new IO::File "< -";
147 foreach ($infh->getlines) {
155 $logfh->print ("\n");
157 # after log information, do an 'cvs -Qq status -v' on each file in the arguments.
159 if ($dostatus != 0) {
161 my $file = shift @files;
163 $logfh->print ("[input file was '-']\n");
165 $mailfh->print ("[input file was '-']\n");
169 my $rcsfh = new IO::File;
170 my $pid = $rcsfh->open ("-|");
173 die "fork failed: $!";
177 my @command = ('cvs', '-nQq', 'status');
182 push @command, $file;
184 die "cvs exec failed: $!";
187 while ($line = $rcsfh->getline) {
188 $logfh->print ($line);
190 $mailfh->print ($line);
198 or die "Write to $logfile failed: $!";
203 die "Pipe to $mailcmd failed" if $?;