Annotation of CVSROOT/log_generate.pl, Revision 1.1
1.1 ! maekawa 1: #!/usr/bin/perl -w
! 2: #
! 3: # $OpenXM$
! 4: #
! 5: # Most parts obtained from FreeBSD.org and modified for OpenXM
! 6: #
! 7:
! 8: require 5.003; # might work with older perl5
! 9:
! 10: use Sys::Hostname; # get hostname() function
! 11:
! 12: ############################################################
! 13: #
! 14: # Configurable options
! 15: #
! 16: ############################################################
! 17: #
! 18: # Where do you want the RCS ID and delta info?
! 19: # 0 = none,
! 20: # 1 = in mail only,
! 21: # 2 = rcsids in both mail and logs.
! 22: #
! 23: $rcsidinfo = 2;
! 24:
! 25: # Debug level, 0 = off
! 26: $debug = 0;
! 27: ############################################################
! 28: #
! 29: # Constants
! 30: #
! 31: ############################################################
! 32: $STATE_NONE = 0;
! 33: $STATE_CHANGED = 1;
! 34: $STATE_ADDED = 2;
! 35: $STATE_REMOVED = 3;
! 36: $STATE_LOG = 4;
! 37:
! 38: $FILE_PREFIX = "#cvs.files";
! 39: $LAST_FILE = "/tmp/#cvs.files.lastdir";
! 40: $CHANGED_FILE = "/tmp/#cvs.files.changed";
! 41: $ADDED_FILE = "/tmp/#cvs.files.added";
! 42: $REMOVED_FILE = "/tmp/#cvs.files.removed";
! 43: $LOG_FILE = "/tmp/#cvs.files.log";
! 44: $SUMMARY_FILE = "/tmp/#cvs.files.summary";
! 45: $MAIL_FILE = "/tmp/#cvs.files.mail";
! 46: $SUBJ_FILE = "/tmp/#cvs.files.subj";
! 47:
! 48: $CVSROOT = $ENV{'CVSROOT'} || "/usr/cvs";
! 49:
! 50: ############################################################
! 51: #
! 52: # Subroutines
! 53: #
! 54: ############################################################
! 55:
! 56: sub cleanup_tmpfiles {
! 57: local($wd, @files);
! 58:
! 59: $wd = `pwd`;
! 60: chdir("/tmp");
! 61: opendir(DIR, ".");
! 62: push(@files, grep(/^$FILE_PREFIX\..*$id$/, readdir(DIR)));
! 63: closedir(DIR);
! 64: foreach (@files) {
! 65: unlink $_;
! 66: }
! 67: chdir($wd);
! 68: }
! 69:
! 70: sub append_to_logfile {
! 71: local($filename, @files) = @_;
! 72:
! 73: open(FILE, ">>$filename") || die ("Cannot open for append file $filename.\n");
! 74: print(FILE join("\n", @lines), "\n");
! 75: close(FILE);
! 76: }
! 77:
! 78: sub append_line {
! 79: local($filename, $line) = @_;
! 80: open(FILE, ">>$filename") || die("Cannot open for append file $filename.\n");
! 81: print(FILE $line, "\n");
! 82: close(FILE);
! 83: }
! 84:
! 85: sub read_line {
! 86: local($line);
! 87: local($filename) = @_;
! 88: open(FILE, "<$filename") || die("Cannot open for read file $filename.\n");
! 89: $line = <FILE>;
! 90: close(FILE);
! 91: chop($line);
! 92: $line;
! 93: }
! 94:
! 95: sub read_logfile {
! 96: local(@text) = ();
! 97: local($filename, $leader) = @_;
! 98: open(FILE, "<$filename") and do {
! 99: while (<FILE>) {
! 100: chop;
! 101: push(@text, $leader.$_);
! 102: }
! 103: close(FILE);
! 104: };
! 105: @text;
! 106: }
! 107:
! 108: sub write_logfile {
! 109: local($filename, @lines) = @_;
! 110:
! 111: open(FILE, ">$filename") || die("Cannot open for write log file $filename.\n");
! 112: print FILE join("\n", @lines), "\n";
! 113: close(FILE);
! 114: }
! 115:
! 116: sub format_names {
! 117: local($dir, @files) = @_;
! 118: local(@lines, $indent);
! 119:
! 120: $indent = length($dir);
! 121: if ($indent < 20) {
! 122: $indent = 20;
! 123: }
! 124:
! 125: $format = " %-" . sprintf("%d", $indent) . "s ";
! 126:
! 127: $lines[0] = sprintf($format, $dir);
! 128:
! 129: if ($debug) {
! 130: print STDERR "format_names(): dir = ", $dir, "; tag = ", $tag, "; files = ", join(":", @files), ".\n";
! 131: }
! 132: foreach $file (@files) {
! 133: if (length($lines[$#lines]) + length($file) > 66) {
! 134: $lines[++$#lines] = sprintf($format, "", "");
! 135: }
! 136: $lines[$#lines] .= $file . " ";
! 137: }
! 138:
! 139: @lines;
! 140: }
! 141:
! 142: sub format_lists {
! 143: local($header, @lines) = @_;
! 144: local(@text, @files, $lastdir, $lastsep, $tag);
! 145:
! 146: if ($debug) {
! 147: print STDERR "format_lists(): ", join(":", @lines), "\n";
! 148: }
! 149: @text = ();
! 150: @files = ();
! 151:
! 152: $lastdir = '';
! 153: $lastsep = '';
! 154: foreach $line (@lines) {
! 155: if ($line =~ /.*\/$/) {
! 156: if ($lastdir ne '') {
! 157: push(@text, &format_names($lastdir, @files));
! 158: }
! 159: $lastdir = $line;
! 160: $lastdir =~ s,/$,,;
! 161: $tag = ""; # next thing is a tag
! 162: @files = ();
! 163: } elsif ($tag eq '') {
! 164: $tag = $line;
! 165: next if ($header . $tag eq $lastsep);
! 166: $lastsep = $header . $tag;
! 167: if ($tag eq 'HEAD') {
! 168: push(@text, " $header files:");
! 169: } else {
! 170: push(@text, sprintf(" %-22s (Branch: %s)", "$header files:",
! 171: $tag));
! 172: }
! 173: } else {
! 174: push(@files, $line);
! 175: }
! 176: }
! 177: push(@text, &format_names($lastdir, @files));
! 178:
! 179: @text;
! 180: }
! 181:
! 182: sub append_names_to_file {
! 183: local($filename, $dir, $tag, @files) = @_;
! 184:
! 185: if (@files) {
! 186: open(FILE, ">>$filename") || die("Cannot open for append file $filename.\n");
! 187: print FILE $dir, "\n";
! 188: print FILE $tag, "\n";
! 189: print FILE join("\n", @files), "\n";
! 190: close(FILE);
! 191: }
! 192: }
! 193:
! 194: #
! 195: # do an 'cvs -Qn status' on each file in the arguments, and extract info.
! 196: #
! 197:
! 198: sub change_summary_changed {
! 199: local($out, $tag, @filenames) = @_;
! 200: local(@revline);
! 201: local($file, $rev, $rcsfile, $line);
! 202:
! 203: while (@filenames) {
! 204: $file = shift @filenames;
! 205:
! 206: if ("$file" eq "") {
! 207: next;
! 208: }
! 209:
! 210: open(RCS, "-|") || exec 'cvs', '-Qn', 'status', $file;
! 211:
! 212: $rev = "";
! 213: $delta = "";
! 214: $rcsfile = "";
! 215:
! 216:
! 217: while (<RCS>) {
! 218: if (/^[ \t]*Repository revision/) {
! 219: chop;
! 220: @revline = split(' ', $_);
! 221: $rev = $revline[2];
! 222: $rcsfile = $revline[3];
! 223: $rcsfile =~ s,^$CVSROOT[/]+,,;
! 224: $rcsfile =~ s/,v$//;
! 225: }
! 226: }
! 227: close(RCS);
! 228:
! 229: if ($rev ne '' && $rcsfile ne '') {
! 230: open(RCS, "-|") || exec 'cvs', '-Qn', 'log', "-r$rev", $file;
! 231: while (<RCS>) {
! 232: if (/^date:/) {
! 233: chop;
! 234: $delta = $_;
! 235: $delta =~ s/^.*;//;
! 236: $delta =~ s/^[\s]+lines://;
! 237: }
! 238: }
! 239: close(RCS);
! 240: }
! 241:
! 242: &append_line($out, sprintf("%-9s%-12s%s", $rev, $delta, $rcsfile));
! 243: }
! 244: }
! 245:
! 246: # Write these one day.
! 247: sub change_summary_added {
! 248: }
! 249: sub change_summary_removed {
! 250: }
! 251:
! 252: sub build_header {
! 253: local($header, $datestr);
! 254: delete $ENV{'TZ'};
! 255:
! 256: $datestr = `/bin/date +"%Y/%m/%d %H:%M:%S %Z"`;
! 257: chop($datestr);
! 258: $header = sprintf("%-8s %s", $login, $datestr);
! 259: }
! 260:
! 261: # !!! Mailing-list and commitlog history file mappings here !!!
! 262: sub mlist_map {
! 263: local($dir) = @_; # perl warns about this....
! 264:
! 265: return 'cvs-admin' if($dir =~ /^CVSROOT\//);
! 266:
! 267: return 'cvs-commiters' if($dir =~ /^OpenXM\//);
! 268:
! 269: return 'cvs-admin';
! 270:
! 271: }
! 272:
! 273: sub do_changes_file {
! 274: local($changes,$category,@mailaddrs);
! 275: local(@text) = @_;
! 276: local(%unique);
! 277:
! 278: %unique = ();
! 279: @mailaddrs = &read_logfile("$MAIL_FILE.$id", "");
! 280: }
! 281:
! 282: sub mail_notification {
! 283: local(@text) = @_;
! 284: local($line, $word, $subjlines, $subjwords, @mailaddrs);
! 285: # local(%unique);
! 286:
! 287: # %unique = ();
! 288:
! 289: print "Mailing the commit message...\n";
! 290:
! 291: @mailaddrs = &read_logfile("$MAIL_FILE.$id", "");
! 292:
! 293: if ($debug) {
! 294: open(MAIL, "| /usr/sbin/mailsend -H $owner$dom");
! 295: } else {
! 296: open(MAIL, "| /usr/sbin/mailsend -H cvs-committers$dom");
! 297: }
! 298:
! 299: # This is turned off since the To: lines go overboard.
! 300: # - but keep it for the time being in case we do something like cvs-stable
! 301: # print(MAIL 'To: cvs-committers' . $dom . ", cvs-all" . $dom);
! 302: # foreach $line (@mailaddrs) {
! 303: # next if ($unique{$line});
! 304: # $unique{$line} = 1;
! 305: # next if /^cvs-/;
! 306: # print(MAIL ", " . $line . $dom);
! 307: # }
! 308: # print(MAIL "\n");
! 309:
! 310: $subject = 'Subject: OpenXM cvs commit:';
! 311: @subj = &read_logfile("$SUBJ_FILE.$id", "");
! 312: $subjlines = 0;
! 313: $subjwords = 0; # minimum of two "words" per line
! 314: LINE: foreach $line (@subj) {
! 315: foreach $word (split(/ /, $line)) {
! 316: if ($subjwords > 2 && length($subject . " " . $word) > 75) {
! 317: if ($subjlines > 2) {
! 318: $subject .= " ...";
! 319: }
! 320: print(MAIL $subject, "\n");
! 321: if ($subjlines > 2) {
! 322: $subject = "";
! 323: last LINE;
! 324: }
! 325: $subject = " "; # rfc822 continuation line
! 326: $subjwords = 0;
! 327: $subjlines++;
! 328: }
! 329: $subject .= " " . $word;
! 330: $subjwords++;
! 331: }
! 332: }
! 333: if ($subject ne "") {
! 334: print(MAIL $subject, "\n");
! 335: }
! 336: print (MAIL "\n");
! 337:
! 338: print(MAIL join("\n", @text));
! 339: close(MAIL);
! 340: }
! 341:
! 342: #############################################################
! 343: #
! 344: # Main Body
! 345: #
! 346: ############################################################
! 347:
! 348: #
! 349: # Setup environment
! 350: #
! 351: umask (002);
! 352: $host = hostname();
! 353: if ($host =~ /^kerberos\.math\.kobe-u\.ac\.jp$/i) {
! 354: $dom = '@kerberos.math.kobe-u.ac.jp';
! 355: $owner = 'maekawa';
! 356: }
! 357:
! 358: #
! 359: # Initialize basic variables
! 360: #
! 361: $id = getpgrp();
! 362: $state = $STATE_NONE;
! 363: $tag = '';
! 364: $login = $ENV{'USER'} || getlogin || (getpwuid($<))[0] || sprintf("uid#%d",$<);
! 365: @files = split(' ', $ARGV[0]);
! 366: @path = split('/', $files[0]);
! 367: if ($#path == 0) {
! 368: $dir = ".";
! 369: } else {
! 370: $dir = join('/', @path[1..$#path]);
! 371: }
! 372: $dir = $dir . "/";
! 373:
! 374: if ($debug) {
! 375: print("ARGV - ", join(":", @ARGV), "\n");
! 376: print("files - ", join(":", @files), "\n");
! 377: print("path - ", join(":", @path), "\n");
! 378: print("dir - ", $dir, "\n");
! 379: print("id - ", $id, "\n");
! 380: }
! 381:
! 382: # Was used for To: lines, still used for commitlogs naming.
! 383: &append_line("$MAIL_FILE.$id", &mlist_map($files[0] . "/"));
! 384: &append_line("$SUBJ_FILE.$id", $ARGV[0]);
! 385:
! 386: #
! 387: # Check for a new directory first. This will always appear as a
! 388: # single item in the argument list, and an empty log message.
! 389: #
! 390: if ($ARGV[0] =~ /New directory/) {
! 391: $header = &build_header();
! 392: @text = ();
! 393: push(@text, $header);
! 394: push(@text, "");
! 395: push(@text, " ".$ARGV[0]);
! 396: &do_changes_file(@text);
! 397: #&mail_notification(@text);
! 398: &cleanup_tmpfiles();
! 399: exit 0;
! 400: }
! 401:
! 402: #
! 403: # Check for an import command. This will always appear as a
! 404: # single item in the argument list, and a log message.
! 405: #
! 406: if ($ARGV[0] =~ /Imported sources/) {
! 407: $header = &build_header();
! 408:
! 409: @text = ();
! 410: push(@text, $header);
! 411: push(@text, "");
! 412:
! 413: push(@text, " ".$ARGV[0]);
! 414: &do_changes_file(@text);
! 415:
! 416: while (<STDIN>) {
! 417: chop; # Drop the newline
! 418: push(@text, " ".$_);
! 419: }
! 420:
! 421: &mail_notification(@text);
! 422: &cleanup_tmpfiles();
! 423: exit 0;
! 424: }
! 425:
! 426: #
! 427: # Iterate over the body of the message collecting information.
! 428: #
! 429: $tag = "HEAD";
! 430: while (<STDIN>) {
! 431: s/[ \t\n]+$//; # delete trailing space
! 432: if (/^Revision\/Branch:/) {
! 433: s,^Revision/Branch:,,;
! 434: $tag = $_;
! 435: next;
! 436: }
! 437: if (/^[ \t]+Tag:/) {
! 438: s,^[ \t]+Tag: ,,;
! 439: $tag = $_;
! 440: next;
! 441: }
! 442: if (/^[ \t]+No tag$/) {
! 443: $tag = "HEAD";
! 444: next;
! 445: }
! 446: if (/^Modified Files/) { $state = $STATE_CHANGED; next; }
! 447: if (/^Added Files/) { $state = $STATE_ADDED; next; }
! 448: if (/^Removed Files/) { $state = $STATE_REMOVED; next; }
! 449: if (/^Log Message/) { $state = $STATE_LOG; next; }
! 450:
! 451: push (@{ $changed_files{$tag} }, split) if ($state == $STATE_CHANGED);
! 452: push (@{ $added_files{$tag} }, split) if ($state == $STATE_ADDED);
! 453: push (@{ $removed_files{$tag} }, split) if ($state == $STATE_REMOVED);
! 454: if ($state == $STATE_LOG) {
! 455: if (/^PR:$/i ||
! 456: /^Reviewed by:$/i ||
! 457: /^Submitted by:$/i ||
! 458: /^Obtained from:$/i) {
! 459: next;
! 460: }
! 461: push (@log_lines, $_);
! 462: }
! 463: }
! 464:
! 465: #
! 466: # Strip leading and trailing blank lines from the log message. Also
! 467: # compress multiple blank lines in the body of the message down to a
! 468: # single blank line.
! 469: # (Note, this only does the mail and changes log, not the rcs log).
! 470: #
! 471: while ($#log_lines > -1) {
! 472: last if ($log_lines[0] ne "");
! 473: shift(@log_lines);
! 474: }
! 475: while ($#log_lines > -1) {
! 476: last if ($log_lines[$#log_lines] ne "");
! 477: pop(@log_lines);
! 478: }
! 479: for ($l = $#log_lines; $l > 0; $l--) {
! 480: if (($log_lines[$l - 1] eq "") && ($log_lines[$l] eq "")) {
! 481: splice(@log_lines, $l, 1);
! 482: }
! 483: }
! 484:
! 485: #
! 486: # Find the log file that matches this log message
! 487: #
! 488: for ($i = 0; ; $i++) {
! 489: last if (! -e "$LOG_FILE.$i.$id");
! 490: @text = &read_logfile("$LOG_FILE.$i.$id", "");
! 491: last if ($#text == -1);
! 492: last if (join(" ", @log_lines) eq join(" ", @text));
! 493: }
! 494:
! 495: #
! 496: # Spit out the information gathered in this pass.
! 497: #
! 498: foreach $tag ( keys %added_files ) {
! 499: &append_names_to_file("$ADDED_FILE.$i.$id", $dir, $tag,
! 500: @{ $added_files{$tag} });
! 501: }
! 502: foreach $tag ( keys %changed_files ) {
! 503: &append_names_to_file("$CHANGED_FILE.$i.$id", $dir, $tag,
! 504: @{ $changed_files{$tag} });
! 505: }
! 506: foreach $tag ( keys %removed_files ) {
! 507: &append_names_to_file("$REMOVED_FILE.$i.$id", $dir, $tag,
! 508: @{ $removed_files{$tag} });
! 509: }
! 510: &write_logfile("$LOG_FILE.$i.$id", @log_lines);
! 511:
! 512: if ($rcsidinfo) {
! 513: foreach $tag ( keys %added_files ) {
! 514: &change_summary_added("$SUMMARY_FILE.$i.$id", $tag,
! 515: @{ $added_files{$tag} });
! 516: }
! 517: foreach $tag ( keys %changed_files ) {
! 518: &change_summary_changed("$SUMMARY_FILE.$i.$id", $tag,
! 519: @{ $changed_files{$tag} });
! 520: }
! 521: foreach $tag ( keys %removed_files ) {
! 522: &change_summary_removed("$SUMMARY_FILE.$i.$id", $tag,
! 523: @{ $removed_files{$tag} });
! 524: }
! 525: }
! 526:
! 527: #
! 528: # Check whether this is the last directory. If not, quit.
! 529: #
! 530: if (-e "$LAST_FILE.$id") {
! 531: $_ = &read_line("$LAST_FILE.$id");
! 532: $tmpfiles=$files[0];
! 533: $tmpfiles =~ s,([^a-zA-Z0-9_/]),\\$1,g;
! 534: if (! grep(/$tmpfiles$/, $_)) {
! 535: print "More commits to come...\n";
! 536: exit 0
! 537: }
! 538: }
! 539:
! 540: #
! 541: # This is it. The commits are all finished. Lump everything together
! 542: # into a single message, fire a copy off to the mailing list, and drop
! 543: # it on the end of the Changes file.
! 544: #
! 545: $header = &build_header();
! 546:
! 547: #
! 548: # Produce the final compilation of the log messages
! 549: #
! 550: @text = ();
! 551: push(@text, $header);
! 552: push(@text, "");
! 553: for ($i = 0; ; $i++) {
! 554: last if (! -e "$LOG_FILE.$i.$id");
! 555: @lines = &read_logfile("$CHANGED_FILE.$i.$id", "");
! 556: if ($#lines >= 0) {
! 557: push(@text, &format_lists("Modified", @lines));
! 558: }
! 559: @lines = &read_logfile("$ADDED_FILE.$i.$id", "");
! 560: if ($#lines >= 0) {
! 561: push(@text, &format_lists("Added", @lines));
! 562: }
! 563: @lines = &read_logfile("$REMOVED_FILE.$i.$id", "");
! 564: if ($#lines >= 0) {
! 565: push(@text, &format_lists("Removed", @lines));
! 566: }
! 567:
! 568: @lines = &read_logfile("$LOG_FILE.$i.$id", " ");
! 569: if ($#lines >= 0) {
! 570: push(@text, " Log:");
! 571: push(@text, @lines);
! 572: }
! 573: if ($rcsidinfo == 2) {
! 574: if (-e "$SUMMARY_FILE.$i.$id") {
! 575: push(@text, " ");
! 576: push(@text, " Revision Changes Path");
! 577: push(@text, &read_logfile("$SUMMARY_FILE.$i.$id", " "));
! 578: }
! 579: }
! 580: push(@text, "", "");
! 581: }
! 582: #
! 583: # Put the log message at the beginning of the Changes file
! 584: #
! 585: &do_changes_file(@text);
! 586:
! 587: #
! 588: # Now generate the extra info for the mail message..
! 589: #
! 590: if ($rcsidinfo == 1) {
! 591: $revhdr = 0;
! 592: for ($i = 0; ; $i++) {
! 593: last if (! -e "$LOG_FILE.$i.$id");
! 594: if (-e "$SUMMARY_FILE.$i.$id") {
! 595: if (!$revhdr++) {
! 596: push(@text, "Revision Changes Path");
! 597: }
! 598: push(@text, &read_logfile("$SUMMARY_FILE.$i.$id", ""));
! 599: }
! 600: }
! 601: if ($revhdr) {
! 602: push(@text, ""); # consistancy...
! 603: }
! 604: }
! 605:
! 606: #
! 607: # Mail out the notification.
! 608: #
! 609: &mail_notification(@text);
! 610: &cleanup_tmpfiles();
! 611: exit 0;
! 612: # EOF
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>