lib/cvs/contrib/log_accum

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