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>
![[BACK]](/icons/back.gif){kind=icon}
Return to loginfo.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / CVSROOT