Annotation of CVSROOT/log_generate.pl, Revision 1.5
1.1 maekawa 1: #!/usr/bin/perl -w
2: #
1.5 ! maekawa 3: # $OpenXM: CVSROOT/log_generate.pl,v 1.4 2000/09/22 17:11:37 maekawa Exp $
1.1 maekawa 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(@text) = @_;
275: local(%unique);
276:
277: %unique = ();
278: @mailaddrs = &read_logfile("$MAIL_FILE.$id", "");
279: }
280:
281: sub mail_notification {
282: local(@text) = @_;
283: local($line, $word, $subjlines, $subjwords, @mailaddrs);
284: # local(%unique);
285:
286: # %unique = ();
287:
288: print "Mailing the commit message...\n";
289:
290: @mailaddrs = &read_logfile("$MAIL_FILE.$id", "");
291:
292: if ($debug) {
293: open(MAIL, "| /usr/sbin/mailsend -H $owner$dom");
294: } else {
1.5 ! maekawa 295: open(MAIL, "| /usr/sbin/mailsend -H cvs-committers$dom");
1.1 maekawa 296: }
297:
298: # This is turned off since the To: lines go overboard.
299: # - but keep it for the time being in case we do something like cvs-stable
300: # print(MAIL 'To: cvs-committers' . $dom . ", cvs-all" . $dom);
301: # foreach $line (@mailaddrs) {
302: # next if ($unique{$line});
303: # $unique{$line} = 1;
304: # next if /^cvs-/;
305: # print(MAIL ", " . $line . $dom);
306: # }
307: # print(MAIL "\n");
308:
309: $subject = 'Subject: OpenXM cvs commit:';
310: @subj = &read_logfile("$SUBJ_FILE.$id", "");
311: $subjlines = 0;
312: $subjwords = 0; # minimum of two "words" per line
313: LINE: foreach $line (@subj) {
314: foreach $word (split(/ /, $line)) {
315: if ($subjwords > 2 && length($subject . " " . $word) > 75) {
316: if ($subjlines > 2) {
317: $subject .= " ...";
318: }
319: print(MAIL $subject, "\n");
320: if ($subjlines > 2) {
321: $subject = "";
322: last LINE;
323: }
324: $subject = " "; # rfc822 continuation line
325: $subjwords = 0;
326: $subjlines++;
327: }
328: $subject .= " " . $word;
329: $subjwords++;
330: }
331: }
332: if ($subject ne "") {
333: print(MAIL $subject, "\n");
334: }
335: print (MAIL "\n");
336:
337: print(MAIL join("\n", @text));
338: close(MAIL);
339: }
340:
341: #############################################################
342: #
343: # Main Body
344: #
345: ############################################################
346:
347: #
348: # Setup environment
349: #
350: umask (002);
351: $host = hostname();
1.3 maekawa 352: if ($host =~ /^kerberos\.math\.sci\.kobe-u\.ac\.jp$/i) {
353: $dom = '@kerberos.math.sci.kobe-u.ac.jp';
1.1 maekawa 354: $owner = 'maekawa';
355: }
356:
357: #
358: # Initialize basic variables
359: #
360: $id = getpgrp();
361: $state = $STATE_NONE;
362: $tag = '';
363: $login = $ENV{'USER'} || getlogin || (getpwuid($<))[0] || sprintf("uid#%d",$<);
364: @files = split(' ', $ARGV[0]);
365: @path = split('/', $files[0]);
366: if ($#path == 0) {
367: $dir = ".";
368: } else {
369: $dir = join('/', @path[1..$#path]);
370: }
371: $dir = $dir . "/";
372:
373: if ($debug) {
374: print("ARGV - ", join(":", @ARGV), "\n");
375: print("files - ", join(":", @files), "\n");
376: print("path - ", join(":", @path), "\n");
377: print("dir - ", $dir, "\n");
378: print("id - ", $id, "\n");
379: }
380:
381: # Was used for To: lines, still used for commitlogs naming.
382: &append_line("$MAIL_FILE.$id", &mlist_map($files[0] . "/"));
383: &append_line("$SUBJ_FILE.$id", $ARGV[0]);
384:
385: #
386: # Check for a new directory first. This will always appear as a
387: # single item in the argument list, and an empty log message.
388: #
389: if ($ARGV[0] =~ /New directory/) {
390: $header = &build_header();
391: @text = ();
392: push(@text, $header);
393: push(@text, "");
394: push(@text, " ".$ARGV[0]);
395: &do_changes_file(@text);
396: #&mail_notification(@text);
397: &cleanup_tmpfiles();
398: exit 0;
399: }
400:
401: #
402: # Check for an import command. This will always appear as a
403: # single item in the argument list, and a log message.
404: #
405: if ($ARGV[0] =~ /Imported sources/) {
406: $header = &build_header();
407:
408: @text = ();
409: push(@text, $header);
410: push(@text, "");
411:
412: push(@text, " ".$ARGV[0]);
413: &do_changes_file(@text);
414:
415: while (<STDIN>) {
416: chop; # Drop the newline
417: push(@text, " ".$_);
418: }
419:
420: &mail_notification(@text);
421: &cleanup_tmpfiles();
422: exit 0;
423: }
424:
425: #
426: # Iterate over the body of the message collecting information.
427: #
428: $tag = "HEAD";
429: while (<STDIN>) {
430: s/[ \t\n]+$//; # delete trailing space
431: if (/^Revision\/Branch:/) {
432: s,^Revision/Branch:,,;
433: $tag = $_;
434: next;
435: }
436: if (/^[ \t]+Tag:/) {
437: s,^[ \t]+Tag: ,,;
438: $tag = $_;
439: next;
440: }
441: if (/^[ \t]+No tag$/) {
442: $tag = "HEAD";
443: next;
444: }
445: if (/^Modified Files/) { $state = $STATE_CHANGED; next; }
446: if (/^Added Files/) { $state = $STATE_ADDED; next; }
447: if (/^Removed Files/) { $state = $STATE_REMOVED; next; }
448: if (/^Log Message/) { $state = $STATE_LOG; next; }
449:
450: push (@{ $changed_files{$tag} }, split) if ($state == $STATE_CHANGED);
451: push (@{ $added_files{$tag} }, split) if ($state == $STATE_ADDED);
452: push (@{ $removed_files{$tag} }, split) if ($state == $STATE_REMOVED);
453: if ($state == $STATE_LOG) {
454: if (/^PR:$/i ||
455: /^Reviewed by:$/i ||
456: /^Submitted by:$/i ||
457: /^Obtained from:$/i) {
458: next;
459: }
460: push (@log_lines, $_);
461: }
462: }
463:
464: #
465: # Strip leading and trailing blank lines from the log message. Also
466: # compress multiple blank lines in the body of the message down to a
467: # single blank line.
468: # (Note, this only does the mail and changes log, not the rcs log).
469: #
470: while ($#log_lines > -1) {
471: last if ($log_lines[0] ne "");
472: shift(@log_lines);
473: }
474: while ($#log_lines > -1) {
475: last if ($log_lines[$#log_lines] ne "");
476: pop(@log_lines);
477: }
478: for ($l = $#log_lines; $l > 0; $l--) {
479: if (($log_lines[$l - 1] eq "") && ($log_lines[$l] eq "")) {
480: splice(@log_lines, $l, 1);
481: }
482: }
483:
484: #
485: # Find the log file that matches this log message
486: #
487: for ($i = 0; ; $i++) {
488: last if (! -e "$LOG_FILE.$i.$id");
489: @text = &read_logfile("$LOG_FILE.$i.$id", "");
490: last if ($#text == -1);
491: last if (join(" ", @log_lines) eq join(" ", @text));
492: }
493:
494: #
495: # Spit out the information gathered in this pass.
496: #
497: foreach $tag ( keys %added_files ) {
498: &append_names_to_file("$ADDED_FILE.$i.$id", $dir, $tag,
499: @{ $added_files{$tag} });
500: }
501: foreach $tag ( keys %changed_files ) {
502: &append_names_to_file("$CHANGED_FILE.$i.$id", $dir, $tag,
503: @{ $changed_files{$tag} });
504: }
505: foreach $tag ( keys %removed_files ) {
506: &append_names_to_file("$REMOVED_FILE.$i.$id", $dir, $tag,
507: @{ $removed_files{$tag} });
508: }
509: &write_logfile("$LOG_FILE.$i.$id", @log_lines);
510:
511: if ($rcsidinfo) {
512: foreach $tag ( keys %added_files ) {
513: &change_summary_added("$SUMMARY_FILE.$i.$id", $tag,
514: @{ $added_files{$tag} });
515: }
516: foreach $tag ( keys %changed_files ) {
517: &change_summary_changed("$SUMMARY_FILE.$i.$id", $tag,
518: @{ $changed_files{$tag} });
519: }
520: foreach $tag ( keys %removed_files ) {
521: &change_summary_removed("$SUMMARY_FILE.$i.$id", $tag,
522: @{ $removed_files{$tag} });
523: }
524: }
525:
526: #
527: # Check whether this is the last directory. If not, quit.
528: #
529: if (-e "$LAST_FILE.$id") {
530: $_ = &read_line("$LAST_FILE.$id");
531: $tmpfiles=$files[0];
532: $tmpfiles =~ s,([^a-zA-Z0-9_/]),\\$1,g;
533: if (! grep(/$tmpfiles$/, $_)) {
534: print "More commits to come...\n";
535: exit 0
536: }
537: }
538:
539: #
540: # This is it. The commits are all finished. Lump everything together
541: # into a single message, fire a copy off to the mailing list, and drop
542: # it on the end of the Changes file.
543: #
544: $header = &build_header();
545:
546: #
547: # Produce the final compilation of the log messages
548: #
549: @text = ();
550: push(@text, $header);
551: push(@text, "");
552: for ($i = 0; ; $i++) {
553: last if (! -e "$LOG_FILE.$i.$id");
554: @lines = &read_logfile("$CHANGED_FILE.$i.$id", "");
555: if ($#lines >= 0) {
556: push(@text, &format_lists("Modified", @lines));
557: }
558: @lines = &read_logfile("$ADDED_FILE.$i.$id", "");
559: if ($#lines >= 0) {
560: push(@text, &format_lists("Added", @lines));
561: }
562: @lines = &read_logfile("$REMOVED_FILE.$i.$id", "");
563: if ($#lines >= 0) {
564: push(@text, &format_lists("Removed", @lines));
565: }
566:
567: @lines = &read_logfile("$LOG_FILE.$i.$id", " ");
568: if ($#lines >= 0) {
569: push(@text, " Log:");
570: push(@text, @lines);
571: }
572: if ($rcsidinfo == 2) {
573: if (-e "$SUMMARY_FILE.$i.$id") {
574: push(@text, " ");
575: push(@text, " Revision Changes Path");
576: push(@text, &read_logfile("$SUMMARY_FILE.$i.$id", " "));
577: }
578: }
579: push(@text, "", "");
580: }
581: #
582: # Put the log message at the beginning of the Changes file
583: #
584: &do_changes_file(@text);
585:
586: #
587: # Now generate the extra info for the mail message..
588: #
589: if ($rcsidinfo == 1) {
590: $revhdr = 0;
591: for ($i = 0; ; $i++) {
592: last if (! -e "$LOG_FILE.$i.$id");
593: if (-e "$SUMMARY_FILE.$i.$id") {
594: if (!$revhdr++) {
595: push(@text, "Revision Changes Path");
596: }
597: push(@text, &read_logfile("$SUMMARY_FILE.$i.$id", ""));
598: }
599: }
600: if ($revhdr) {
601: push(@text, ""); # consistancy...
602: }
603: }
604:
605: #
606: # Mail out the notification.
607: #
608: &mail_notification(@text);
609: &cleanup_tmpfiles();
610: exit 0;
611: # EOF
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to log_generate.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / CVSROOT