4 #ident "@(#)ccvs/contrib:$Name: $:$Id: log_accum,v 1.1 2006/05/09 00:27:49 bdemsky Exp $"
6 # Perl filter to handle the log messages from the checkin of files in
7 # a directory. This script will group the lists of files by log
8 # message, and mail a single consolidated log message at the end of
11 # This file assumes a pre-commit checking program that leaves the
12 # names of the first and last commit directories in a temporary file.
14 # Contributed by David Hampton <hampton@cisco.com>
16 # hacked greatly by Greg A. Woods <woods@planix.com>
18 # modified by C. Scott Ananian <cananian@alumni.princeton.edu> to add
19 # support for including a diff of the changes in the commit email.
21 # Usage: log_accum.pl [-d] [-s] [-M module] [[-m mailto] ...] [[-R replyto] ...] [-f logfile]
22 # -d - turn on debugging
23 # -m mailto - send mail to "mailto" (multiple)
24 # -R replyto - set the "Reply-To:" to "replyto" (multiple)
25 # -M modulename - set module name to "modulename"
26 # -f logfile - write commit messages to logfile too
27 # -s - *don't* run "cvs status -v" for each file
28 # -u - run "cvs diff -u" for each file
31 # Configurable options
34 # set this to something that takes a whole message on stdin
35 $MAILER = "/usr/lib/sendmail -t";
38 # End user configurable options.
41 # Constants (don't change these!)
49 $LAST_FILE = "/tmp/#cvs.lastdir";
50 $DIFF_FILE = "/tmp/#cvs.diff";
52 $CHANGED_FILE = "/tmp/#cvs.files.changed";
53 $ADDED_FILE = "/tmp/#cvs.files.added";
54 $REMOVED_FILE = "/tmp/#cvs.files.removed";
55 $LOG_FILE = "/tmp/#cvs.files.log";
57 $FILE_PREFIX = "#cvs.files";
63 sub cleanup_tmpfiles {
67 chdir("/tmp") || die("Can't chdir('/tmp')\n");
69 push(@files, grep(/^$FILE_PREFIX\..*\.$id$/, readdir(DIR)));
74 unlink $DIFF_FILE . "." . $id;
75 unlink $LAST_FILE . "." . $id;
81 local($filename, @lines) = @_;
83 open(FILE, ">$filename") || die("Cannot open log file $filename.\n");
84 print FILE join("\n", @lines), "\n";
88 sub append_to_logfile {
89 local($filename, @lines) = @_;
91 open(FILE, ">$filename") || die("Cannot open log file $filename.\n");
92 print FILE join("\n", @lines), "\n";
97 local($dir, @files) = @_;
100 $format = "\t%-" . sprintf("%d", length($dir)) . "s%s ";
102 $lines[0] = sprintf($format, $dir, ":");
105 print STDERR "format_names(): dir = ", $dir, "; files = ", join(":", @files), ".\n";
107 foreach $file (@files) {
108 if (length($lines[$#lines]) + length($file) > 65) {
109 $lines[++$#lines] = sprintf($format, " ", " ");
111 $lines[$#lines] .= $file . " ";
119 local(@text, @files, $lastdir);
122 print STDERR "format_lists(): ", join(":", @lines), "\n";
126 $lastdir = shift @lines; # first thing is always a directory
127 if ($lastdir !~ /.*\/$/) {
128 die("Damn, $lastdir doesn't look like a directory!\n");
130 foreach $line (@lines) {
131 if ($line =~ /.*\/$/) {
132 push(@text, &format_names($lastdir, @files));
139 push(@text, &format_names($lastdir, @files));
144 sub append_names_to_file {
145 local($filename, $dir, @files) = @_;
148 open(FILE, ">>$filename") || die("Cannot open file $filename.\n");
149 print FILE $dir, "\n";
150 print FILE join("\n", @files), "\n";
157 local($filename) = @_;
159 open(FILE, "<$filename") || die("Cannot open file $filename.\n");
168 local($filename, $leader) = @_;
170 open(FILE, "<$filename");
173 push(@text, $leader.$_);
181 local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
182 $header = sprintf("CVSROOT:\t%s\nModule name:\t%s\nChanges by:\t%s@%s\t%02d/%02d/%02d %02d:%02d:%02d",
186 $year%100, $mon+1, $mday,
190 sub mail_notification {
193 # if only we had strftime()... stuff stolen from perl's ctime.pl:
196 @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
197 @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
198 'Jul','Aug','Sep','Oct','Nov','Dec');
200 # Determine what time zone is in effect.
201 # Use GMT if TZ is defined as null, local time if TZ undefined.
202 # There's no portable way to find the system default timezone.
204 $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
206 # Hack to deal with 'PST8PDT' format of TZ
207 # Note that this can't deal with all the esoteric forms, but it
208 # does recognize the most common: [:]STDoff[DST[off][,rule]]
210 if ($TZ =~ /^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/) {
211 $TZ = $isdst ? $4 : $1;
212 $tzoff = sprintf("%05d", -($2) * 100);
215 # perl-4.036 doesn't have the $zone or $gmtoff...
216 ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $zone, $gmtoff) =
217 ($TZ eq 'GMT') ? gmtime(time) : localtime(time);
219 $year += ($year < 70) ? 2000 : 1900;
222 $tzoff = sprintf("%05d", ($gmtoff / 60) * 100);
229 $rfc822date = sprintf("%s, %2d %s %4d %2d:%02d:%02d %s (%s)",
230 $DoW[$wday], $mday, $MoY[$mon], $year,
231 $hour, $min, $sec, $tzoff, $TZ);
233 open(MAIL, "| $MAILER");
234 print MAIL "Date: " . $rfc822date . "\n";
235 print MAIL "Subject: CVS Update: " . $modulename . "\n";
236 print MAIL "To: " . $mailto . "\n";
237 print MAIL "From: " . $login . "@" . $hostdomain . "\n";
238 print MAIL "Reply-To: " . $replyto . "\n";
240 print MAIL join("\n", @text), "\n";
244 sub write_commitlog {
245 local($logfile, @text) = @_;
247 open(FILE, ">>$logfile");
248 print FILE join("\n", @text), "\n";
256 # Initialize basic variables
259 $id = getpgrp(); # note, you *must* use a shell which does setpgrp()
260 $state = $STATE_NONE;
261 $login = getlogin || (getpwuid($<))[0] || "nobody";
262 chop($hostname = `hostname`);
263 #chop($domainname = `domainname`);
264 #$hostdomain = $hostname . $domainname;
265 chop($domainname = `hostname -d`);
266 chop($hostdomain = `hostname --fqdn`);
267 $cvsroot = $ENV{'CVSROOT'};
272 # parse command line arguments (file list is seen as one arg)
279 print STDERR "Debug turned on...\n";
280 } elsif ($arg eq '-m') {
282 $mailto = shift @ARGV;
284 $mailto = $mailto . ", " . shift @ARGV;
286 } elsif ($arg eq '-R') {
287 if ($replyto eq '') {
288 $replyto = shift @ARGV;
290 $replyto = $replyto . ", " . shift @ARGV;
292 } elsif ($arg eq '-M') {
293 $modulename = shift @ARGV;
294 } elsif ($arg eq '-s') {
296 } elsif ($arg eq '-u') {
298 } elsif ($arg eq '-f') {
299 ($commitlog) && die("Too many '-f' args\n");
300 $commitlog = shift @ARGV;
302 ($donefiles) && die("Too many arguments! Check usage.\n");
304 @files = split(/ /, $arg);
307 ($mailto) || die("No mail recipient specified (use -m)\n");
308 if ($replyto eq '') {
312 # for now, the first "file" is the repository directory being committed,
313 # relative to the $CVSROOT location
315 @path = split('/', $files[0]);
317 # XXX there are some ugly assumptions in here about module names and
318 # XXX directories relative to the $CVSROOT location -- really should
319 # XXX read $CVSROOT/CVSROOT/modules, but that's not so easy to do, since
320 # XXX we have to parse it backwards.
322 if ($modulename eq "") {
323 $modulename = $path[0]; # I.e. the module name == top-level dir
328 $dir = join('/', @path);
333 print STDERR "module - ", $modulename, "\n";
334 print STDERR "dir - ", $dir, "\n";
335 print STDERR "path - ", join(":", @path), "\n";
336 print STDERR "files - ", join(":", @files), "\n";
337 print STDERR "id - ", $id, "\n";
340 # Check for a new directory first. This appears with files set as follows:
342 # files[0] - "path/name/newdir"
345 # files[3] - "directory"
347 if ($files[2] =~ /New/ && $files[3] =~ /directory/) {
351 push(@text, &build_header());
353 push(@text, $files[0]);
357 chop; # Drop the newline
361 &mail_notification($mailto, @text);
366 # Check for an import command. This appears with files set as follows:
368 # files[0] - "path/name"
370 # files[2] - "Imported"
371 # files[3] - "sources"
373 if ($files[2] =~ /Imported/ && $files[3] =~ /sources/) {
377 push(@text, &build_header());
379 push(@text, $files[0]);
383 chop; # Drop the newline
387 &mail_notification(@text);
392 # Iterate over the body of the message collecting information.
395 chop; # Drop the newline
397 if (/^In directory/) {
398 push(@log_lines, $_);
399 push(@log_lines, "");
403 if (/^Modified Files/) { $state = $STATE_CHANGED; next; }
404 if (/^Added Files/) { $state = $STATE_ADDED; next; }
405 if (/^Removed Files/) { $state = $STATE_REMOVED; next; }
406 if (/^Log Message/) { $state = $STATE_LOG; next; }
408 s/^[ \t\n]+//; # delete leading whitespace
409 s/[ \t\n]+$//; # delete trailing whitespace
411 if ($state == $STATE_CHANGED) { push(@changed_files, split); }
412 if ($state == $STATE_ADDED) { push(@added_files, split); }
413 if ($state == $STATE_REMOVED) { push(@removed_files, split); }
414 if ($state == $STATE_LOG) { push(@log_lines, $_); }
417 # Strip leading and trailing blank lines from the log message. Also
418 # compress multiple blank lines in the body of the message down to a
421 while ($#log_lines > -1) {
422 last if ($log_lines[0] ne "");
425 while ($#log_lines > -1) {
426 last if ($log_lines[$#log_lines] ne "");
429 for ($i = $#log_lines; $i > 0; $i--) {
430 if (($log_lines[$i - 1] eq "") && ($log_lines[$i] eq "")) {
431 splice(@log_lines, $i, 1);
436 print STDERR "Searching for log file index...";
438 # Find an index to a log file that matches this log message
440 for ($i = 0; ; $i++) {
443 last if (! -e "$LOG_FILE.$i.$id"); # the next available one
444 @text = &read_logfile("$LOG_FILE.$i.$id", "");
445 last if ($#text == -1); # nothing in this file, use it
446 last if (join(" ", @log_lines) eq join(" ", @text)); # it's the same log message as another
449 print STDERR " found log file at $i.$id, now writing tmp files.\n";
452 # Spit out the information gathered in this pass.
454 &append_names_to_file("$CHANGED_FILE.$i.$id", $dir, @changed_files);
455 &append_names_to_file("$ADDED_FILE.$i.$id", $dir, @added_files);
456 &append_names_to_file("$REMOVED_FILE.$i.$id", $dir, @removed_files);
457 &write_logfile("$LOG_FILE.$i.$id", @log_lines);
459 # Check whether this is the last directory. If not, quit.
462 print STDERR "Checking current dir against last dir.\n";
464 $_ = &read_line("$LAST_FILE.$id");
466 if ($_ ne $cvsroot . "/" . $files[0]) {
468 print STDERR sprintf("Current directory %s is not last directory %s.\n", $cvsroot . "/" .$files[0], $_);
473 print STDERR sprintf("Current directory %s is last directory %s -- all commits done.\n", $files[0], $_);
480 # This is it. The commits are all finished. Lump everything together
481 # into a single message, fire a copy off to the mailing list, and drop
482 # it on the end of the Changes file.
486 # Produce the final compilation of the log messages
490 push(@text, &build_header());
493 for ($i = 0; ; $i++) {
494 last if (! -e "$LOG_FILE.$i.$id"); # we're done them all!
495 @lines = &read_logfile("$CHANGED_FILE.$i.$id", "");
497 push(@text, "Modified files:");
498 push(@text, &format_lists(@lines));
500 @lines = &read_logfile("$ADDED_FILE.$i.$id", "");
502 push(@text, "Added files:");
503 push(@text, &format_lists(@lines));
505 @lines = &read_logfile("$REMOVED_FILE.$i.$id", "");
507 push(@text, "Removed files:");
508 push(@text, &format_lists(@lines));
513 @lines = &read_logfile("$LOG_FILE.$i.$id", "\t");
515 push(@text, "Log message:");
520 local(@changed_files);
523 push(@changed_files, &read_logfile("$CHANGED_FILE.$i.$id", ""));
524 push(@changed_files, &read_logfile("$ADDED_FILE.$i.$id", ""));
525 push(@changed_files, &read_logfile("$REMOVED_FILE.$i.$id", ""));
528 print STDERR "main: pre-sort changed_files = ", join(":", @changed_files), ".\n";
530 sort(@changed_files);
532 print STDERR "main: post-sort changed_files = ", join(":", @changed_files), ".\n";
535 foreach $dofile (@changed_files) {
536 if ($dofile =~ /\/$/) {
537 next; # ignore the silly "dir" entries
541 "main(): doing 'cvs -nQq status -v $dofile'\n";
543 open(STATUS, "-|") ||
544 exec 'cvs', '-nQq', 'status', '-v', $dofile;
547 push(@status_txt, $_);
556 @diff_txt = &read_logfile("$DIFF_FILE.$id", "") if ($do_diff);
558 # Write to the commitlog file
561 &write_commitlog($commitlog, @text);
564 if ($#diff_txt >= 0) {
565 push(@text, "-----------------------------------------------------");
566 push(@text, "Changes made in this commit:");
567 push(@text, "-----------------------------------------------------");
569 push(@text, @diff_txt);
572 if ($#status_txt >= 0) {
573 push(@text, @status_txt);
576 # Mailout the notification.
578 &mail_notification(@text);