scripts/log_accum

   1 #! /usr/bin/perl
   2 # -*-Perl-*-
   3 #
   4 # Perl filter to handle the log messages from the checkin of files in
   5 # a directory.  This script will group the lists of files by log
   6 # message, and mail a single consolidated log message at the end of
   7 # the commit.
   8 #
   9 # This file assumes a pre-commit checking program that leaves the
  10 # names of the first and last commit directories in a temporary file.
  11 #
  12 # Contributed by David Hampton <hampton@cisco.com>
  13 #
  14 # hacked greatly by Greg A. Woods <woods@planix.com>
  15 #
  16 # Modified by werner.koch@guug.de to add support for
  17 #       automagically extraction of ChangeLog entries           1998-12-29
  18
  19 # Usage: log_accum.pl [-d] [-s] [-M module] [[-m mailto] ...] [[-R replyto] ...] [-f logfile]
  20 #       -d              - turn on debugging
  21 #       -m mailto       - send mail to "mailto" (multiple)
  22 #       -R replyto      - set the "Reply-To:" to "replyto" (multiple)
  23 #       -M modulename   - set module name to "modulename"
  24 #       -f logfile      - write commit messages to logfile too
  25 #       -s              - *don't* run "cvs status -v" for each file
  26 #       -w              - show working directory with log message
  27
  28 #
  29 #       Configurable options
  30 #
  31
  32 # set this to something that takes a whole message on stdin
  33 $MAILER        = "/usr/lib/sendmail -t";
  34
  35 #
  36 #       End user configurable options.
  37 #
  38
  39 # Constants (don't change these!)
  40 #
  41 $STATE_NONE    = 0;
  42 $STATE_CHANGED = 1;
  43 $STATE_ADDED   = 2;
  44 $STATE_REMOVED = 3;
  45 $STATE_LOG     = 4;
  46
  47 $LAST_FILE     = "/tmp/#cvs.lastdir";
  48
  49 $CHANGED_FILE  = "/tmp/#cvs.files.changed";
  50 $ADDED_FILE    = "/tmp/#cvs.files.added";
  51 $REMOVED_FILE  = "/tmp/#cvs.files.removed";
  52 $LOG_FILE      = "/tmp/#cvs.files.log";
  53
  54 $FILE_PREFIX   = "#cvs.files";
  55
  56 #
  57 #       Subroutines
  58 #
  59
  60 sub cleanup_tmpfiles {
  61     local($wd, @files);
  62
  63     $wd = `pwd`;
  64     chdir("/tmp") || die("Can't chdir('/tmp')\n");
  65     opendir(DIR, ".");
  66     push(@files, grep(/^$FILE_PREFIX\..*\.$id$/, readdir(DIR)));
  67     closedir(DIR);
  68     foreach (@files) {
  69         unlink $_;
  70     }
  71     unlink $LAST_FILE . "." . $id;
  72
  73     chdir($wd);
  74 }
  75
  76 sub write_logfile {
  77     local($filename, @lines) = @_;
  78
  79     open(FILE, ">$filename") || die("Cannot open log file $filename.\n");
  80     print FILE join("\n", @lines), "\n";
  81     close(FILE);
  82 }
  83
  84 sub append_to_logfile {
  85     local($filename, @lines) = @_;
  86
  87     open(FILE, ">$filename") || die("Cannot open log file $filename.\n");
  88     print FILE join("\n", @lines), "\n";
  89     close(FILE);
  90 }
  91
  92 sub format_names {
  93     local($dir, @files) = @_;
  94     local(@lines);
  95
  96     $format = "\t%-" . sprintf("%d", length($dir)) . "s%s ";
  97
  98     $lines[0] = sprintf($format, $dir, ":");
  99
 100     if ($debug) {
 101         print STDERR "format_names(): dir = ", $dir, "; files = ", join(":", @files), ".\n";
 102     }
 103     foreach $file (@files) {
 104         if (length($lines[$#lines]) + length($file) > 65) {
 105             $lines[++$#lines] = sprintf($format, " ", " ");
 106         }
 107         $lines[$#lines] .= $file . " ";
 108     }
 109
 110     @lines;
 111 }
 112
 113 sub format_lists {
 114     local(@lines) = @_;
 115     local(@text, @files, $lastdir);
 116
 117     if ($debug) {
 118         print STDERR "format_lists(): ", join(":", @lines), "\n";
 119     }
 120     @text = ();
 121     @files = ();
 122     $lastdir = shift @lines;    # first thing is always a directory
 123     if ($lastdir !~ /.*\/$/) {
 124         die("Damn, $lastdir doesn't look like a directory!\n");
 125     }
 126     foreach $line (@lines) {
 127         if ($line =~ /.*\/$/) {
 128             push(@text, &format_names($lastdir, @files));
 129             $lastdir = $line;
 130             @files = ();
 131         } else {
 132             push(@files, $line);
 133         }
 134     }
 135     push(@text, &format_names($lastdir, @files));
 136
 137     @text;
 138 }
 139
 140 sub append_names_to_file {
 141     local($filename, $dir, @files) = @_;
 142
 143     if (@files) {
 144         open(FILE, ">>$filename") || die("Cannot open file $filename.\n");
 145         print FILE $dir, "\n";
 146         print FILE join("\n", @files), "\n";
 147         close(FILE);
 148     }
 149 }
 150
 151 sub read_line {
 152     local($line);
 153     local($filename) = @_;
 154
 155     open(FILE, "<$filename") || die("Cannot open file $filename.\n");
 156     $line = <FILE>;
 157     close(FILE);
 158     chop($line);
 159     $line;
 160 }
 161
 162 sub read_logfile {
 163     local(@text);
 164     local($filename, $leader) = @_;
 165
 166     open(FILE, "<$filename");
 167     while (<FILE>) {
 168         chop;
 169         push(@text, $leader.$_);
 170     }
 171     close(FILE);
 172     @text;
 173 }
 174
 175 sub build_header {
 176     local($header);
 177     local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 178     $header = sprintf("CVSROOT:\t%s\nModule name:\t%s\nRepository:\t%s\nChanges by:\t%s@%s\t%02d/%02d/%02d %02d:%02d:%02d",
 179                       $cvsroot,
 180                       $modulename,
 181                       $dir,
 182                       $login, $hostdomain,
 183                       $year%100, $mon+1, $mday,
 184                       $hour, $min, $sec);
 185 }
 186
 187 sub mail_notification {
 188     local(@text) = @_;
 189
 190     # if only we had strftime()...  stuff stolen from perl's ctime.pl:
 191     local($[) = 0;
 192
 193     @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
 194     @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
 195             'Jul','Aug','Sep','Oct','Nov','Dec');
 196
 197     # Determine what time zone is in effect.
 198     # Use GMT if TZ is defined as null, local time if TZ undefined.
 199     # There's no portable way to find the system default timezone.
 200     #
 201     $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
 202
 203     # Hack to deal with 'PST8PDT' format of TZ
 204     # Note that this can't deal with all the esoteric forms, but it
 205     # does recognize the most common: [:]STDoff[DST[off][,rule]]
 206     #
 207     if ($TZ =~ /^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/) {
 208         $TZ = $isdst ? $4 : $1;
 209         $tzoff = sprintf("%05d", -($2) * 100);
 210     }
 211
 212     # perl-4.036 doesn't have the $zone or $gmtoff...
 213     ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $zone, $gmtoff) =
 214         ($TZ eq 'GMT') ? gmtime(time) : localtime(time);
 215
 216     $year += ($year < 70) ? 2000 : 1900;
 217
 218     if ($gmtoff != 0) {
 219         $tzoff = sprintf("%05d", ($gmtoff / 60) * 100);
 220     }
 221     if ($zone ne '') {
 222         $TZ = $zone;
 223     }
 224
 225     # ok, let's try....
 226     $rfc822date = sprintf("%s, %2d %s %4d %2d:%02d:%02d %s (%s)",
 227                           $DoW[$wday], $mday, $MoY[$mon], $year,
 228                           $hour, $min, $sec, $tzoff, $TZ);
 229
 230     open(MAIL, "| $MAILER");
 231     print MAIL "Date:     " . $rfc822date . "\n";
 232     print MAIL "Subject:  CVS Update: " . $modulename . "\n";
 233     print MAIL "To:       " . $mailto . "\n";
 234     print MAIL "Reply-To: " . $replyto . "\n";
 235     print MAIL "\n";
 236     print MAIL join("\n", @text), "\n";
 237     close(MAIL);
 238 }
 239
 240 sub write_commitlog {
 241     local($logfile, @text) = @_;
 242
 243     open(FILE, ">>$logfile");
 244     print FILE join("\n", @text), "\n";
 245     close(FILE);
 246 }
 247
 248 #
 249 #       Main Body
 250 #
 251
 252 # Initialize basic variables
 253 #
 254 $debug = 0;
 255 $id = getpgrp();                # note, you *must* use a shell which does setpgrp()
 256 $state = $STATE_NONE;
 257 $login = getlogin || (getpwuid($<))[0] || "nobody";
 258 chop($hostname = `hostname`);
 259 chop($domainname = `domainname`);
 260 if ($domainname !~ '^\..*') {
 261     $domainname = '.' . $domainname;
 262 }
 263 $hostdomain = $hostname . $domainname;
 264 $cvsroot = $ENV{'CVSROOT'};
 265 $do_status = 1;                 # moderately useful
 266 $show_wd = 0;                   # useless in client/server
 267 $modulename = "";
 268
 269 # parse command line arguments (file list is seen as one arg)
 270 #
 271 while (@ARGV) {
 272     $arg = shift @ARGV;
 273
 274     if ($arg eq '-d') {
 275         $debug = 1;
 276         print STDERR "Debug turned on...\n";
 277     } elsif ($arg eq '-m') {
 278         if ($mailto eq '') {
 279             $mailto = shift @ARGV;
 280         } else {
 281             $mailto = $mailto . ", " . shift @ARGV;
 282         }
 283     } elsif ($arg eq '-R') {
 284         if ($replyto eq '') {
 285             $replyto = shift @ARGV;
 286         } else {
 287             $replyto = $replyto . ", " . shift @ARGV;
 288         }
 289     } elsif ($arg eq '-M') {
 290         $modulename = shift @ARGV;
 291     } elsif ($arg eq '-s') {
 292         $do_status = 0;
 293     } elsif ($arg eq '-w') {
 294         $show_wd = 1;
 295     } elsif ($arg eq '-f') {
 296         ($commitlog) && die("Too many '-f' args\n");
 297         $commitlog = shift @ARGV;
 298     } else {
 299         ($donefiles) && die("Too many arguments!  Check usage.\n");
 300         $donefiles = 1;
 301         @files = split(/ /, $arg);
 302     }
 303 }
 304 ($mailto) || die("No mail recipient specified (use -m)\n");
 305 if ($replyto eq '') {
 306     $replyto = $login;
 307 }
 308
 309 # for now, the first "file" is the repository directory being committed,
 310 # relative to the $CVSROOT location
 311 #
 312 @path = split('/', $files[0]);
 313
 314 # XXX There are some ugly assumptions in here about module names and
 315 # XXX directories relative to the $CVSROOT location -- really should
 316 # XXX read $CVSROOT/CVSROOT/modules, but that's not so easy to do, since
 317 # XXX we have to parse it backwards.
 318 # XXX
 319 # XXX Fortunately it's relatively easy for the user to specify the
 320 # XXX module name as appropriate with a '-M' via the directory
 321 # XXX matching in loginfo.
 322 #
 323 if ($modulename eq "") {
 324     $modulename = $path[0];     # I.e. the module name == top-level dir
 325 }
 326 if ($#path == 0) {
 327     $dir = ".";
 328 } else {
 329     $dir = join('/', @path);
 330 }
 331 $dir = $dir . "/";
 332
 333 if ($debug) {
 334     print STDERR "module - ", $modulename, "\n";
 335     print STDERR "dir    - ", $dir, "\n";
 336     print STDERR "path   - ", join(":", @path), "\n";
 337     print STDERR "files  - ", join(":", @files), "\n";
 338     print STDERR "id     - ", $id, "\n";
 339 }
 340
 341 # Check for a new directory first.  This appears with files set as follows:
 342 #
 343 #    files[0] - "path/name/newdir"
 344 #    files[1] - "-"
 345 #    files[2] - "New"
 346 #    files[3] - "directory"
 347 #
 348 if ($files[2] =~ /New/ && $files[3] =~ /directory/) {
 349     local(@text);
 350
 351     @text = ();
 352     push(@text, &build_header());
 353     push(@text, "");
 354     push(@text, $files[0]);
 355     push(@text, "");
 356
 357     while (<STDIN>) {
 358         chop;                   # Drop the newline
 359         push(@text, $_);
 360     }
 361
 362     &mail_notification($mailto, @text);
 363
 364     exit 0;
 365 }
 366
 367 # Check for an import command.  This appears with files set as follows:
 368 #
 369 #    files[0] - "path/name"
 370 #    files[1] - "-"
 371 #    files[2] - "Imported"
 372 #    files[3] - "sources"
 373 #
 374 if ($files[2] =~ /Imported/ && $files[3] =~ /sources/) {
 375     local(@text);
 376
 377     @text = ();
 378     push(@text, &build_header());
 379     push(@text, "");
 380     push(@text, $files[0]);
 381     push(@text, "");
 382
 383     while (<STDIN>) {
 384         chop;                   # Drop the newline
 385         push(@text, $_);
 386     }
 387
 388     &mail_notification(@text);
 389
 390     exit 0;
 391 }
 392
 393 # Iterate over the body of the message collecting information.
 394 #
 395 while (<STDIN>) {
 396     chop;                       # Drop the newline
 397
 398     if (/^In directory/) {
 399         if ($show_wd) {         # useless in client/server mode
 400             push(@log_lines, $_);
 401             push(@log_lines, "");
 402         }
 403         next;
 404     }
 405
 406     if (/^Modified Files/) { $state = $STATE_CHANGED; next; }
 407     if (/^Added Files/)    { $state = $STATE_ADDED;   next; }
 408     if (/^Removed Files/)  { $state = $STATE_REMOVED; next; }
 409     if (/^Log Message/)    { $state = $STATE_LOG;     next; }
 410
 411     s/^[ \t\n]+//;              # delete leading whitespace
 412     s/[ \t\n]+$//;              # delete trailing whitespace
 413
 414     if ($state == $STATE_CHANGED) { push(@changed_files, split); }
 415     if ($state == $STATE_ADDED)   { push(@added_files,   split); }
 416     if ($state == $STATE_REMOVED) { push(@removed_files, split); }
 417     if ($state == $STATE_LOG)     {
 418         if( /^See[ ]ChangeLog:[ ](.*)/ ) {
 419             $changelog = $1;
 420             $okay = false;
 421             open(RCS, "-|") || exec 'cvs', '-Qn', 'update', '-p', 'ChangeLog';
 422             while (<RCS>) {
 423                 if( /^$changelog .*/ ) {
 424                     $okay = true;
 425                     push(@log_lines,     $_);
 426                 }
 427                 elsif( $okay ) {
 428                     last if( /^[A-Z]+.*/ );
 429                     push(@log_lines,     $_);
 430                 }
 431             }
 432             while (<RCS>) { ; }
 433             close(RCS);
 434         }
 435         else {
 436             push(@log_lines, $_);
 437         }
 438     }
 439 }
 440
 441 # Strip leading and trailing blank lines from the log message.  Also
 442 # compress multiple blank lines in the body of the message down to a
 443 # single blank line.
 444 #
 445 while ($#log_lines > -1) {
 446     last if ($log_lines[0] ne "");
 447     shift(@log_lines);
 448 }
 449 while ($#log_lines > -1) {
 450     last if ($log_lines[$#log_lines] ne "");
 451     pop(@log_lines);
 452 }
 453 for ($i = $#log_lines; $i > 0; $i--) {
 454     if (($log_lines[$i - 1] eq "") && ($log_lines[$i] eq "")) {
 455         splice(@log_lines, $i, 1);
 456     }
 457 }
 458
 459 if ($debug) {
 460     print STDERR "Searching for log file index...";
 461 }
 462 # Find an index to a log file that matches this log message
 463 #
 464 for ($i = 0; ; $i++) {
 465     local(@text);
 466
 467     last if (! -e "$LOG_FILE.$i.$id"); # the next available one
 468     @text = &read_logfile("$LOG_FILE.$i.$id", "");
 469     last if ($#text == -1);     # nothing in this file, use it
 470     last if (join(" ", @log_lines) eq join(" ", @text)); # it's the same log message as another
 471 }
 472 if ($debug) {
 473     print STDERR " found log file at $i.$id, now writing tmp files.\n";
 474 }
 475
 476 # Spit out the information gathered in this pass.
 477 #
 478 &append_names_to_file("$CHANGED_FILE.$i.$id", $dir, @changed_files);
 479 &append_names_to_file("$ADDED_FILE.$i.$id",   $dir, @added_files);
 480 &append_names_to_file("$REMOVED_FILE.$i.$id", $dir, @removed_files);
 481 &write_logfile("$LOG_FILE.$i.$id", @log_lines);
 482
 483 # Check whether this is the last directory.  If not, quit.
 484 #
 485 if ($debug) {
 486     print STDERR "Checking current dir against last dir.\n";
 487 }
 488 $_ = &read_line("$LAST_FILE.$id");
 489
 490 if ($_ ne $cvsroot . "/" . $files[0]) {
 491     if ($debug) {
 492         print STDERR sprintf("Current directory %s is not last directory %s.\n", $cvsroot . "/" .$files[0], $_);
 493     }
 494     exit 0;
 495 }
 496 if ($debug) {
 497     print STDERR sprintf("Current directory %s is last directory %s -- all commits done.\n", $files[0], $_);
 498 }
 499
 500 #
 501 #       End Of Commits!
 502 #
 503
 504 # This is it.  The commits are all finished.  Lump everything together
 505 # into a single message, fire a copy off to the mailing list, and drop
 506 # it on the end of the Changes file.
 507 #
 508
 509 #
 510 # Produce the final compilation of the log messages
 511 #
 512 @text = ();
 513 @status_txt = ();
 514 push(@text, &build_header());
 515 push(@text, "");
 516
 517 for ($i = 0; ; $i++) {
 518     last if (! -e "$LOG_FILE.$i.$id"); # we're done them all!
 519     @lines = &read_logfile("$CHANGED_FILE.$i.$id", "");
 520     if ($#lines >= 0) {
 521         push(@text, "Modified files:");
 522         push(@text, &format_lists(@lines));
 523     }
 524     @lines = &read_logfile("$ADDED_FILE.$i.$id", "");
 525     if ($#lines >= 0) {
 526         push(@text, "Added files:");
 527         push(@text, &format_lists(@lines));
 528     }
 529     @lines = &read_logfile("$REMOVED_FILE.$i.$id", "");
 530     if ($#lines >= 0) {
 531         push(@text, "Removed files:");
 532         push(@text, &format_lists(@lines));
 533     }
 534     if ($#text >= 0) {
 535         push(@text, "");
 536     }
 537     @lines = &read_logfile("$LOG_FILE.$i.$id", "\t");
 538     if ($#lines >= 0) {
 539         push(@text, "Log message:");
 540         push(@text, @lines);
 541         push(@text, "");
 542     }
 543     if ($do_status) {
 544         local(@changed_files);
 545
 546         @changed_files = ();
 547         push(@changed_files, &read_logfile("$CHANGED_FILE.$i.$id", ""));
 548         push(@changed_files, &read_logfile("$ADDED_FILE.$i.$id", ""));
 549         push(@changed_files, &read_logfile("$REMOVED_FILE.$i.$id", ""));
 550
 551         if ($debug) {
 552             print STDERR "main: pre-sort changed_files = ", join(":", @changed_files), ".\n";
 553         }
 554         sort(@changed_files);
 555         if ($debug) {
 556             print STDERR "main: post-sort changed_files = ", join(":", @changed_files), ".\n";
 557         }
 558
 559         foreach $dofile (@changed_files) {
 560             if ($dofile =~ /\/$/) {
 561                 next;           # ignore the silly "dir" entries
 562             }
 563             if ($debug) {
 564                 print STDERR "main(): doing 'cvs -nQq status -v $dofile'\n";
 565             }
 566             open(STATUS, "-|") || exec 'cvs', '-nQq', 'status', '-v', $dofile;
 567             while (<STATUS>) {
 568                 chop;
 569                 push(@status_txt, $_);
 570             }
 571         }
 572     }
 573 }
 574
 575 # Write to the commitlog file
 576 #
 577 if ($commitlog) {
 578     &write_commitlog($commitlog, @text);
 579 }
 580
 581 if ($#status_txt >= 0) {
 582     push(@text, @status_txt);
 583 }
 584
 585 # Mailout the notification.
 586 #
 587 &mail_notification(@text);
 588
 589 # cleanup
 590 #
 591 if (! $debug) {
 592     &cleanup_tmpfiles();
 593 }
 594
 595 exit 0;