Annotation of CVSROOT/loginfo.pl, revision 1.1

1.1     ! albertel    1: #!/usr/bin/perl -w
        !             2: # include this script in your loginfo as:
        !             3: # <modulename>   /path/to/loginfo.pl sender@domain recipient@domain %{sVv}
        !             4: #
        !             5: # Copyright (c) 1999, 2000 Sascha Schumann <sascha@schumann.cx>
        !             6: 
        !             7: # This makes some basic assumptions -- you are only checking
        !             8: # in to a single CVS module.
        !             9: 
        !            10: # This also doesn't like files or directories with spaces in them.
        !            11: 
        !            12: use strict;
        !            13: 
        !            14: use Socket;
        !            15: use POSIX;
        !            16: 
        !            17: $SIG{PIPE} = 'IGNORE';
        !            18: 
        !            19: my $last_file  = "/var/cvs/lastdir";
        !            20: my $summary    = "/var/cvs/summary";
        !            21: my $smtpserver = "127.0.0.1";
        !            22: my $smtpport   = 25;
        !            23: my $cvs        = "/usr/bin/cvs";
        !            24: my $cvsroot    = $ENV{CVSROOT}."/";
        !            25: # remove double trailing slash
        !            26: $cvsroot =~ s/\/\/$/\//;
        !            27: my $cvsusers   = "/repository/CVSROOT/cvsusers";
        !            28: 
        !            29: # get the id of this process group for use in figuring out
        !            30: # whether this is the last directory with checkins or not
        !            31: my $id = getpgrp();
        !            32: 
        !            33: # the command line looks something like this for a normal commit:
        !            34: #  ("user@example.com", "cvsuser",
        !            35: #   "module changedfile,1.1,1.2 addedfile,NONE,1.1 removedfile,1.1,NONE")
        !            36: my $mailfrom = shift;
        !            37: my $mailto = $mailfrom;
        !            38: my $envaddr = $mailto;
        !            39: 
        !            40: my $cvsuser = shift;
        !            41: my @args = split(" ", $ARGV[0]);
        !            42: my $directory = shift @args;
        !            43: 
        !            44: # extract just the module name from the directory
        !            45: my $module = $directory;
        !            46: $module =~ s/\/.+$//;
        !            47: 
        !            48: if ($cvsuser eq "changelog" && $module ne "php-gtk") {
        !            49: 	$envaddr = "php-cvs-daily-private\@lists.php.net";
        !            50: 	$mailto  = "php-cvs-daily\@lists.php.net";
        !            51: }
        !            52: 
        !            53: # bail when this is a new directory
        !            54: &bail if $args[0] eq '-' && "$args[1] $args[2]" eq 'New directory';
        !            55: 
        !            56: # bail if this is an import
        !            57: &bail if $args[0] eq '-' && $args[1] eq 'Imported';
        !            58: 
        !            59: # find out the last directory being processed
        !            60: open FC, "$last_file.$id"
        !            61: 	or die "last file does not exist";
        !            62: my $last_directory = <FC>;
        !            63: chop $last_directory;
        !            64: close FC;
        !            65: # remove the cvsroot from the front
        !            66: $last_directory =~ s/^$cvsroot//;
        !            67: 
        !            68: # add our changed files to the summary
        !            69: open(FC, ">>$summary.$id") || die "cannot open summary file";
        !            70: foreach my $arg (@args) {
        !            71: 	print FC "$directory/$arg\n";
        !            72: }
        !            73: close(FC);
        !            74: 
        !            75: # is this script already in the last changed directory?
        !            76: 
        !            77: # exit if this isn't the last directory
        !            78: &bail if($last_directory ne $directory);
        !            79: 
        !            80: # get the log message and tag -- we throw away everything from STDIN
        !            81: # before a line that begins with "Log Message"
        !            82: my ($logmsg,$tag) = &get_log_message();
        !            83: 
        !            84: # now we fork off into the background and generate the email
        !            85: exit 0 if(fork() != 0);
        !            86: 
        !            87: $| = 1;
        !            88: 
        !            89: #print "Reading summary file\n";
        !            90: 
        !            91: open(FC, "<$summary.$id");
        !            92: 
        !            93: my (@added_files, @removed_files, @modified_files, @modified_files_info);
        !            94: while (<FC>) {
        !            95: 	chop;
        !            96: 	my ($file, $old, $new) = split(",");
        !            97: 	if($old eq "NONE") {
        !            98: 		push @added_files, $file;
        !            99: 	} elsif($new eq "NONE") {
        !           100: 		push @removed_files, $file;
        !           101: 	} else {
        !           102: 		push @modified_files, $file;
        !           103: 		push @modified_files_info, [ $file, $old, $new ];
        !           104: 	}
        !           105: }
        !           106: close FC;
        !           107: 
        !           108: #print "Unlinking helper files\n";
        !           109: 
        !           110: # clean up a little bit
        !           111: 
        !           112: unlink("$summary.$id");
        !           113: unlink("$last_file.$id");
        !           114: 
        !           115: #print "Running rdiff\n";
        !           116: 
        !           117: # build a diff (and new files) if necessary
        !           118: my $diffmsg = '';
        !           119: 
        !           120: foreach my $info (@modified_files_info) {
        !           121: 	my ($file, $old, $new) = @$info;
        !           122: 	open(LOG, "$cvs -Qn rdiff -r $old -r $new -u $file|") || die;
        !           123: 	while(<LOG>) { s/\r\n/\n/; $diffmsg .= $_; }
        !           124: 	close(LOG);
        !           125: }
        !           126: 
        !           127: # add the added files
        !           128: 
        !           129: foreach my $file (@added_files) {
        !           130: 	next if $file =~ /\.(gif|jpe|jpe?g|pdf|png|exe|class|tgz|tar.gz|jar)$/i
        !           131: 		or $file !~ /\./;
        !           132: 	$diffmsg .= "\nIndex: $file\n+++ $file\n";
        !           133: 	open(LOG, "$cvs -Qn checkout -p -r1.1 $file |") || die;
        !           134: 	while(<LOG>) { s/\r\n/\n/; $diffmsg .= $_; }
        !           135: 	close(LOG);
        !           136: }
        !           137: 
        !           138: #print "Building commit email\n";
        !           139: 
        !           140: my $subj_tag = $tag ? "($tag)" : '';
        !           141: my $body_tag = $tag ? "(Branch: $tag)" : '';
        !           142: 
        !           143: # build our email
        !           144: my $msg = "";
        !           145: if($#added_files ne -1) {
        !           146: 	$msg .= "\n  Added files:                 $body_tag";
        !           147: 	$msg .= &build_list(@added_files);
        !           148: 	$body_tag = '';
        !           149: }
        !           150: if($#removed_files ne -1) {
        !           151: 	$msg .= "\n  Removed files:               $body_tag";
        !           152: 	$msg .= &build_list(@removed_files);
        !           153: 	$body_tag = '';
        !           154: }
        !           155: if($#modified_files ne -1) {
        !           156: 	$msg .= "\n  Modified files:              $body_tag";
        !           157: 	$msg .= &build_list(@modified_files);
        !           158: 	$body_tag = '';
        !           159: }
        !           160: 
        !           161: my $subj = "";
        !           162: my %dirfiles;
        !           163: my @dirs = &get_dirs(@added_files, @removed_files, @modified_files);
        !           164: 
        !           165: foreach my $dir (@dirs) {
        !           166:     $subj .= "$dir @{ $dirfiles{$dir} }  ";
        !           167: }
        !           168: 
        !           169: my $msgid = "Message-ID: <cvs$cvsuser".time()."\@cvsserver>\n";
        !           170: 
        !           171: my $from;
        !           172: if (open FD, $cvsusers) {
        !           173: 	while(<FD>) {
        !           174: 		chop;
        !           175: 		if (m/^$cvsuser:(.+?):(.+)$/) {
        !           176: 			$from = "\"$1\" <$2>";
        !           177: 		}
        !           178: 	}
        !           179: 	close(FD);
        !           180: }
        !           181: 
        !           182: $from ||= "$cvsuser <$mailfrom>";
        !           183: 
        !           184: # "Reply-to: $mailto\n".
        !           185: # "Date: ".localtime()."\n".
        !           186: my (@DAYABBR) = qw(Sun Mon Tue Wed Thu Fri Sat);
        !           187: my (@MONABBR) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
        !           188: 
        !           189: my (@gmtime) = gmtime();
        !           190: my $rfc822date = sprintf("Date: %s, %02d %s %d %02d:%02d:%02d -0000\n",
        !           191:         $DAYABBR[$gmtime[6]], $gmtime[3], $MONABBR[$gmtime[4]],
        !           192:         $gmtime[5] + 1900, $gmtime[2], $gmtime[1], $gmtime[0]);
        !           193: 
        !           194: no strict; # quiet warnings after here
        !           195: 
        !           196: my $email;
        !           197: my $common_header = "".
        !           198: 	"From: $from\n".
        !           199: 	"To: $mailto\n".
        !           200: 	$msgid.
        !           201: 	$rfc822date.
        !           202: 	"Subject: cvs: $module$subj_tag $subj\n";
        !           203: 
        !           204: my $common_body = "".
        !           205: 	"$cvsuser\t\t".localtime()." EDT\n".
        !           206: 	"$msg".
        !           207: 	"  Log:\n".
        !           208: 	&indent($logmsg,2)."\n";
        !           209: 
        !           210: my $boundary = $cvsuser.time();
        !           211: 
        !           212: if (length($diffmsg) > 8000) {
        !           213: 	my $now = POSIX::strftime("%Y%m%d%H%M%S", localtime);
        !           214: 	$email = $common_header.
        !           215: 		"MIME-Version: 1.0\n".
        !           216: 		"Content-Type: multipart/mixed; boundary=\"$boundary\"\n".
        !           217: 		"\n".
        !           218: 		"This is a MIME encoded message\n\n".
        !           219: 		"--$boundary\n".
        !           220: 		"Content-Type: text/plain\n".
        !           221: 		"\n".
        !           222: 		$common_body.
        !           223: 		"--$boundary\n".
        !           224: 		"Content-Type: text/plain\n".
        !           225: 		"Content-Disposition: attachment; filename=\"$cvsuser-$now.txt\"\n".
        !           226: 		"\n".
        !           227: 		"$diffmsg\n".
        !           228: 		"--$boundary--\n";
        !           229: } else {
        !           230: 	$email = $common_header.
        !           231: 		"\n".
        !           232: 		$common_body.
        !           233: 		"$diffmsg\n";
        !           234: }
        !           235: 
        !           236: $email =~ s/\r//g;
        !           237: $email =~ s/\n/\r\n/g;
        !           238: 
        !           239: # send our email
        !           240: 
        !           241: print "Mailing the commit email to $mailto\n";
        !           242: 
        !           243: #print $email;
        !           244: 
        !           245: my $paddr = sockaddr_in($smtpport, inet_aton($smtpserver));
        !           246: socket(SOCK, PF_INET, SOCK_STREAM, 0) || die "socket failed";
        !           247: connect(SOCK, $paddr) || die "connect $smtpserver:$smtpport failed";
        !           248: select(SOCK);
        !           249: $|=1;
        !           250: 
        !           251: print "HELO cvsserver\r\n".
        !           252: "MAIL FROM:<this-will-bounce\@php.net>\r\n" . 
        !           253: "RCPT TO:<$envaddr>\r\n" .
        !           254: "DATA\r\n".
        !           255: "$email\r\n".
        !           256: ".\r\n".
        !           257: "QUIT\r\n";
        !           258: 
        !           259: while(<SOCK>) { alarm(20); };
        !           260: 
        !           261: close(SOCK);
        !           262: exit 0;
        !           263: 
        !           264: sub get_log_message {
        !           265:   my ($logmsg, $tag);
        !           266:   while (<STDIN>) {
        !           267:     $logmsg .= $_ if defined $logmsg;
        !           268:     if (/^Log Message/) { $logmsg = ""; }
        !           269:     if (/^\s+Tag:\s+(\w+)/) { $tag = $1; }
        !           270:   }
        !           271:   return ($logmsg, $tag);
        !           272: }
        !           273: 
        !           274: sub build_list {
        !           275:   my(@arr) = @_;
        !           276:   my($curdir, $curlen, $msg);
        !           277: 
        !           278:   $msg = "";
        !           279:   $curdir = "";
        !           280:   foreach (@arr) {
        !           281:     /^(.*)\/([^\/]+)$/;
        !           282:     my $dir = $1;
        !           283:     my $file = $2;
        !           284:     if($dir ne $curdir) {
        !           285:       $curdir = $dir;
        !           286:       $msg .= "\n    /$curdir\t";
        !           287:       $curlen = length($curdir) + 5;
        !           288:     }
        !           289:     if(($curlen + length($file)) > 70) {
        !           290:       $msg .= "\n     ".sprintf("%-".length($curdir)."s", "")."\t";
        !           291:       $curlen = length($curdir) + 5;
        !           292:     }
        !           293:     $msg .= $file." ";
        !           294:     $curlen += length($file) + 1;
        !           295:   }
        !           296: 
        !           297:   $msg .= "\n";
        !           298: 
        !           299:   return $msg;
        !           300: }
        !           301: 
        !           302: sub get_dirs {
        !           303:   my @files = sort @_;
        !           304:   foreach my $file (@files) {
        !           305:     (my $dir = $file) =~ s#[^/]+$##;
        !           306:     $dir =~ s/^$module//;
        !           307:     $dir =~ s/(.+)\//$1/;
        !           308:     $file =~ s#^.+/(.+)$#$1#;
        !           309:     push @{ $dirfiles{$dir} }, $file;
        !           310:   } 
        !           311:   return sort keys %dirfiles;
        !           312: } 
        !           313: 
        !           314: sub indent {
        !           315:   my ($msg,$nr) = @_;
        !           316:   my $s = " " x $nr;
        !           317:   $msg =~ s/\n/\n$s/g;
        !           318:   return $s.$msg;
        !           319: }
        !           320: 
        !           321: sub trim {
        !           322:   my ($x) = @_;
        !           323:   $x =~ s/^\s+//;
        !           324:   $x =~ s/\s+$//;
        !           325:   return $x;
        !           326: }
        !           327: 
        !           328: # eat STDIN (to avoid parent getting SIGPIPE) and exit with supplied exit code
        !           329: sub bail {
        !           330:   my @toss = <STDIN>;
        !           331:   exit @_;
        !           332: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>