/[cvs]/ccvs/contrib/log_accum.pl
ViewVC logotype

Diff of /ccvs/contrib/log_accum.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by dprice, Fri Jan 5 18:18:18 2001 UTC revision 1.10 by dprice, Thu Oct 6 20:25:12 2005 UTC
# Line 1  Line 1 
1  #! xPERL_PATHx  #! @PERL@ -T
2  # -*-Perl-*-  # -*-Perl-*-
3  #  
4    # Copyright (C) 1994-2005 The Free Software Foundation, Inc.
5    
6    # This program is free software; you can redistribute it and/or modify
7    # it under the terms of the GNU General Public License as published by
8    # the Free Software Foundation; either version 2, or (at your option)
9    # any later version.
10    #
11    # This program is distributed in the hope that it will be useful,
12    # but WITHOUT ANY WARRANTY; without even the implied warranty of
13    # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14    # GNU General Public License for more details.
15    
16    ###############################################################################
17    ###############################################################################
18    ###############################################################################
19    #
20    # THIS SCRIPT IS PROBABLY BROKEN.  REMOVING THE -T SWITCH ON THE #! LINE ABOVE
21    # WOULD FIX IT, BUT THIS IS INSECURE.  WE RECOMMEND FIXING THE ERRORS WHICH THE
22    # -T SWITCH WILL CAUSE PERL TO REPORT BEFORE RUNNING THIS SCRIPT FROM A CVS
23    # SERVER TRIGGER.  PLEASE SEND PATCHES CONTAINING THE CHANGES YOU FIND
24    # NECESSARY TO RUN THIS SCRIPT WITH THE TAINT-CHECKING ENABLED BACK TO THE
25    # <@PACKAGE_BUGREPORT@> MAILING LIST.
26    #
27    # For more on general Perl security and taint-checking, please try running the
28    # `perldoc perlsec' command.
29    #
30    ###############################################################################
31    ###############################################################################
32    ###############################################################################
33    
34  # Perl filter to handle the log messages from the checkin of files in  # Perl filter to handle the log messages from the checkin of files in
35  # a directory.  This script will group the lists of files by log  # a directory.  This script will group the lists of files by log
36  # message, and mail a single consolidated log message at the end of  # message, and mail a single consolidated log message at the end of
# Line 9  Line 39 
39  # This file assumes a pre-commit checking program that leaves the  # This file assumes a pre-commit checking program that leaves the
40  # names of the first and last commit directories in a temporary file.  # names of the first and last commit directories in a temporary file.
41  #  #
42    # IMPORTANT: what the above means is, this script interacts with
43    # commit_prep, in that they have to agree on the tmpfile name to use.
44    # See $LAST_FILE below.
45    #
46    # How this works: CVS triggers this script once for each directory
47    # involved in the commit -- in other words, a single commit can invoke
48    # this script N times.  It knows when it's on the last invocation by
49    # examining the contents of $LAST_FILE.  Between invocations, it
50    # caches information for its future incarnations in various temporary
51    # files in /tmp, which are named according to the process group and
52    # the committer (by themselves, neither of these are unique, but
53    # together they almost always are, unless the same user is doing two
54    # commits simultaneously).  The final invocation is the one that
55    # actually sends the mail -- it gathers up the cached information,
56    # combines that with what it found out on this pass, and sends a
57    # commit message to the appropriate mailing list.
58    #
59    # (Ask Karl Fogel <kfogel@collab.net> if questions.)
60    #
61  # Contributed by David Hampton <hampton@cisco.com>  # Contributed by David Hampton <hampton@cisco.com>
62    # Roy Fielding removed useless code and added log/mail of new files
63    # Ken Coar added special processing (i.e., no diffs) for binary files
64  #  #
 # hacked greatly by Greg A. Woods <woods@planix.com>  
   
 # Usage: log_accum.pl [-d] [-s] [-w] [-M module] [-u user] [[-m mailto] ...] [[-R replyto] ...] [-f logfile]  
 #       -d              - turn on debugging  
 #       -m mailto       - send mail to "mailto" (multiple)  
 #       -R replyto      - set the "Reply-To:" to "replyto" (multiple)  
 #       -M modulename   - set module name to "modulename"  
 #       -f logfile      - write commit messages to logfile too  
 #       -s              - *don't* run "cvs status -v" for each file  
 #       -w              - show working directory with log message  
 #       -u user         - $USER passed from loginfo  
65    
66    ############################################################
67  #  #
68  #       Configurable options  # Configurable options
69  #  #
70    ############################################################
71  # set this to something that takes a whole message on stdin  #
72  $MAILER        = "/usr/lib/sendmail -t";  # The newest versions of CVS have UseNewInfoFmtStrings=yes
73    # to change the arguments being passed on the command line.
74    # If you are using %1s on the command line, then set this
75    # value to 0.
76    # 0 = old-style %1s format. use split(' ') to separate ARGV into filesnames.
77    # 1 = new-style %s format. Note: allows spaces in filenames.
78    my $UseNewInfoFmtStrings = 1;
79    
80  #  #
81  #       End user configurable options.  # Where do you want the RCS ID and delta info?
82    # 0 = none,
83    # 1 = in mail only,
84    # 2 = in both mail and logs.
85  #  #
86    $rcsidinfo = 2;
87    
88    #if you are using CVS web then set this to some value... if not set it to ""
89    #
90    # When set properly, this will cause links to aspects of the project to
91    # print in the commit emails.
92    #$CVSWEB_SCHEME = "http";
93    #$CVSWEB_DOMAIN = "nongnu.org";
94    #$CVSWEB_PORT = "80";
95    #$CVSWEB_URI = "source/browse/";
96    #$SEND_URL = "true";
97    $SEND_DIFF = "true";
98    
99    
100  # Constants (don't change these!)  # Set this to a domain to have CVS pretend that all users who make
101    # commits have mail accounts within that domain.
102    #$EMULATE_LOCAL_MAIL_USER="nongnu.org";
103    
104    # Set this to '-c' for context diffs; defaults to '-u' for unidiff format.
105    $difftype = '-uN';
106    
107    ############################################################
108    #
109    # Constants
110  #  #
111    ############################################################
112  $STATE_NONE    = 0;  $STATE_NONE    = 0;
113  $STATE_CHANGED = 1;  $STATE_CHANGED = 1;
114  $STATE_ADDED   = 2;  $STATE_ADDED   = 2;
115  $STATE_REMOVED = 3;  $STATE_REMOVED = 3;
116  $STATE_LOG     = 4;  $STATE_LOG     = 4;
117    
118  $LAST_FILE     = "/tmp/#cvs.lastdir";  $TMPDIR        = $ENV{'TMPDIR'} || '/tmp';
119    $FILE_PREFIX   = '#cvs.';
120    
121  $CHANGED_FILE  = "/tmp/#cvs.files.changed";  $LAST_FILE     = "$TMPDIR/${FILE_PREFIX}lastdir";  # Created by commit_prep!
122  $ADDED_FILE    = "/tmp/#cvs.files.added";  $ADDED_FILE    = "$TMPDIR/${FILE_PREFIX}files.added";
123  $REMOVED_FILE  = "/tmp/#cvs.files.removed";  $REMOVED_FILE  = "$TMPDIR/${FILE_PREFIX}files.removed";
124  $LOG_FILE      = "/tmp/#cvs.files.log";  $LOG_FILE      = "$TMPDIR/${FILE_PREFIX}files.log";
125    $BRANCH_FILE   = "$TMPDIR/${FILE_PREFIX}files.branch";
126    $SUMMARY_FILE  = "$TMPDIR/${FILE_PREFIX}files.summary";
127    
128  $FILE_PREFIX   = "#cvs.files";  $MAIL_CMD      = "| /usr/lib/sendmail -i -t";
129    #$MAIL_CMD      = "| /var/qmail/bin/qmail-inject";
130    $SUBJECT_PRE   = 'CVS update:';
131    
132    
133    ############################################################
134  #  #
135  #       Subroutines  # Subroutines
136  #  #
137    ############################################################
138    
139    sub format_names {
140        local($dir, @files) = @_;
141        local(@lines);
142    
143        $lines[0] = sprintf(" %-08s", $dir);
144        foreach $file (@files) {
145            if (length($lines[$#lines]) + length($file) > 60) {
146                $lines[++$#lines] = sprintf(" %8s", " ");
147            }
148            $lines[$#lines] .= " ".$file;
149        }
150        @lines;
151    }
152    
153  sub cleanup_tmpfiles {  sub cleanup_tmpfiles {
154      local($wd, @files);      local(@files);
155    
156      $wd = `pwd`;      opendir(DIR, $TMPDIR);
157      chdir("/tmp") || die("Can't chdir('/tmp')\n");      push(@files, grep(/^${FILE_PREFIX}.*\.${id}\.${cvs_user}$/, readdir(DIR)));
     opendir(DIR, ".");  
     push(@files, grep(/^$FILE_PREFIX\..*\.$id$/, readdir(DIR)));  
158      closedir(DIR);      closedir(DIR);
159      foreach (@files) {      foreach (@files) {
160          unlink $_;          unlink "$TMPDIR/$_";
161      }      }
     unlink $LAST_FILE . "." . $id;  
   
     chdir($wd);  
162  }  }
163    
164  sub write_logfile {  sub write_logfile {
165      local($filename, @lines) = @_;      local($filename, @lines) = @_;
166    
167      open(FILE, ">$filename") || die("Cannot open log file $filename.\n");      open(FILE, ">$filename") || die ("Cannot open log file $filename: $!\n");
168      print FILE join("\n", @lines), "\n";      print(FILE join("\n", @lines), "\n");
169      close(FILE);      close(FILE);
170  }  }
171    
172  sub append_to_logfile {  sub append_to_file {
173      local($filename, @lines) = @_;      local($filename, $dir, @files) = @_;
174    
175      open(FILE, ">$filename") || die("Cannot open log file $filename.\n");      if (@files) {
176      print FILE join("\n", @lines), "\n";          local(@lines) = &format_names($dir, @files);
177      close(FILE);          open(FILE, ">>$filename") || die ("Cannot open file $filename: $!\n");
178            print(FILE join("\n", @lines), "\n");
179            close(FILE);
180        }
181  }  }
182    
183  sub format_names {  sub write_line {
184      local($dir, @files) = @_;      local($filename, $line) = @_;
     local(@lines);  
   
     $format = "\t%-" . sprintf("%d", length($dir)) . "s%s ";  
185    
186      $lines[0] = sprintf($format, $dir, ":");      open(FILE, ">$filename") || die("Cannot open file $filename: $!\n");
187        print(FILE $line, "\n");
188        close(FILE);
189    }
190    
191      if ($debug) {  sub append_line {
192          print STDERR "format_names(): dir = ", $dir, "; files = ", join(":", @files), ".\n";      local($filename, $line) = @_;
     }  
     foreach $file (@files) {  
         if (length($lines[$#lines]) + length($file) > 65) {  
             $lines[++$#lines] = sprintf($format, " ", " ");  
         }  
         $lines[$#lines] .= $file . " ";  
     }  
193    
194      @lines;      open(FILE, ">>$filename") || die("Cannot open file $filename: $!\n");
195        print(FILE $line, "\n");
196        close(FILE);
197  }  }
198    
199  sub format_lists {  sub read_line {
200      local(@lines) = @_;      local($filename) = @_;
201      local(@text, @files, $lastdir);      local($line);
202    
203      if ($debug) {      open(FILE, "<$filename") || die("Cannot open file $filename: $!\n");
204          print STDERR "format_lists(): ", join(":", @lines), "\n";      $line = <FILE>;
205      }      close(FILE);
206      @text = ();      chomp($line);
207      @files = ();      $line;
208      $lastdir = shift @lines;    # first thing is always a directory  }
     if ($lastdir !~ /.*\/$/) {  
         die("Damn, $lastdir doesn't look like a directory!\n");  
     }  
     foreach $line (@lines) {  
         if ($line =~ /.*\/$/) {  
             push(@text, &format_names($lastdir, @files));  
             $lastdir = $line;  
             @files = ();  
         } else {  
             push(@files, $line);  
         }  
     }  
     push(@text, &format_names($lastdir, @files));  
209    
210      @text;  sub read_line_nodie {
211        local($filename) = @_;
212        local($line);
213        open(FILE, "<$filename") || return ("");
214    
215        $line = <FILE>;
216        close(FILE);
217        chomp($line);
218        $line;
219  }  }
220    
221  sub append_names_to_file {  sub read_file_lines {
222      local($filename, $dir, @files) = @_;      local($filename) = @_;
223        local(@text) = ();
224    
225      if (@files) {      open(FILE, "<$filename") || return ();
226          open(FILE, ">>$filename") || die("Cannot open file $filename.\n");      while (<FILE>) {
227          print FILE $dir, "\n";          chomp;
228          print FILE join("\n", @files), "\n";          push(@text, $_);
         close(FILE);  
229      }      }
230        close(FILE);
231        @text;
232  }  }
233    
234  sub read_line {  sub read_file {
235      local($line);      local($filename, $leader) = @_;
236      local($filename) = @_;      local(@text) = ();
237    
238      open(FILE, "<$filename") || die("Cannot open file $filename.\n");      open(FILE, "<$filename") || return ();
239      $line = <FILE>;      while (<FILE>) {
240            chomp;
241            push(@text, sprintf("  %-10s  %s", $leader, $_));
242            $leader = "";
243        }
244      close(FILE);      close(FILE);
245      chop($line);      @text;
     $line;  
246  }  }
247    
248  sub read_logfile {  sub read_logfile {
     local(@text);  
249      local($filename, $leader) = @_;      local($filename, $leader) = @_;
250        local(@text) = ();
251    
252      open(FILE, "<$filename");      open(FILE, "<$filename") || die ("Cannot open log file $filename: $!\n");
253      while (<FILE>) {      while (<FILE>) {
254          chop;          chomp;
255          push(@text, $leader.$_);          push(@text, $leader.$_);
256      }      }
257      close(FILE);      close(FILE);
258      @text;      @text;
259  }  }
260    
261    #
262    # do an 'cvs -Qn status' on each file in the arguments, and extract info.
263    #
264    sub change_summary {
265        local($out, @filenames) = @_;
266        local($file, $rcsfile, $line, $vhost, $cvsweb_base);
267    
268        while (@filenames) {
269            $file = shift @filenames;
270    
271            if ("$file" eq "") {
272                next;
273            }
274    
275            $delta = "";
276            $rcsfile = "$update_dir/$file";
277    
278            if ($oldrev{$file}) {
279                open(RCS, "-|") || exec "$cvsbin/cvs", '-Qn', 'log',
280                                        "-r$newrev{$file}",
281                                        '--', $file;
282                while (<RCS>) {
283                    if (/^date:.*lines:([^;]+);.*/) {
284                        $delta = $1;
285                        last;
286                    }
287                }
288                close(RCS);
289            }
290    
291            $diff = "\n\n";
292            $vhost = $path[0];
293            if ($CVSWEB_PORT eq "80") {
294              $cvsweb_base = "$CVSWEB_SCHEME://$vhost.$CVSWEB_DOMAIN/$CVSWEB_URI";
295            }
296            else {
297              $cvsweb_base = "$CVSWEB_SCHEME://$vhost.$CVSWEB_DOMAIN:$CVSWEB_PORT/$CVSWEB_URI";
298            }
299            if ($SEND_URL eq "true") {
300              $diff .= $cvsweb_base . join("/", @path) . "/$file";
301            }
302    
303            #
304            # If this is a binary file, don't try to report a diff; not only is
305            # it meaningless, but it also screws up some mailers.  We rely on
306            # Perl's 'is this binary' algorithm; it's pretty good.  But not
307            # perfect.
308            #
309            if (($file =~ /\.(?:pdf|gif|jpg|mpg)$/i) || (-B $file)) {
310              if ($SEND_URL eq "true") {
311                $diff .= "?rev=" . $newrev{$file};
312                $diff .= "&content-type=text/x-cvsweb-markup\n\n";
313              }
314              if ($SEND_DIFF eq "true") {
315                $diff .= "\t<<Binary file>>\n\n";
316              }
317            }
318            else {
319                #
320                # Get the differences between this and the previous revision,
321                # being aware that new files always have revision '1.1' and
322                # new branches always end in '.n.1'.
323                #
324                if ($SEND_URL eq "true") {
325                  if (!$oldrev{$file} || !$newrev{$file}) {
326                    $diff .= "?rev=" . $oldrev{$file};
327                    $diff .= "&content-type=text/x-cvsweb-markup\n\n";
328                  } else {
329                    $diff .= ".diff?r1=$oldrev{$file}&r2=$newrev{$file}\n\n";
330                  }
331                }
332    
333                if ($SEND_DIFF eq "true") {
334                  $diff .= "(In the diff below, changes in quantity "
335                        . "of whitespace are not shown.)\n\n";
336                  open(DIFF, "-|")
337                    || exec "$cvsbin/cvs", '-Qn', 'diff', "$difftype",
338                    '-b', "-r$oldrev{$file}", "-r$newrev{$file}", '--', $file;
339    
340                  while (<DIFF>) {
341                    $diff .= $_;
342                  }
343                  close(DIFF);
344    
345                  $diff .= "\n\n";
346               }
347            }
348    
349            &append_line($out, sprintf("%-9s%-12s%s%s",
350                                       $newrev{$file} ? $newrev{$file} : "dead",
351                                       $delta, $rcsfile, $diff));
352        }
353    }
354    
355    
356  sub build_header {  sub build_header {
357      local($header);      local($header);
358      local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);      delete $ENV{'TZ'};
359      $header = sprintf("CVSROOT:\t%s\nModule name:\t%s\nRepository:\t%s\nChanges by:\t%s@%s\t%02d/%02d/%02d %02d:%02d:%02d",      local($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
360                        $cvsroot,  
361                        $modulename,      $header = sprintf("  User: %-8s\n  Date: %02d/%02d/%02d %02d:%02d:%02d",
362                        $dir,                         $cvs_user, $year%100, $mon+1, $mday,
363                        $login, $hostdomain,                         $hour, $min, $sec);
364                        $year%100, $mon+1, $mday,  #    $header = sprintf("%-8s    %02d/%02d/%02d %02d:%02d:%02d",
365                        $hour, $min, $sec);  #                       $login, $year%100, $mon+1, $mday,
366  }  #                       $hour, $min, $sec);
   
 sub mail_notification {  
     local(@text) = @_;  
   
     # if only we had strftime()...  stuff stolen from perl's ctime.pl:  
     local($[) = 0;  
   
     @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');  
     @MoY = ('Jan','Feb','Mar','Apr','May','Jun',  
             'Jul','Aug','Sep','Oct','Nov','Dec');  
   
     # Determine what time zone is in effect.  
     # Use GMT if TZ is defined as null, local time if TZ undefined.  
     # There's no portable way to find the system default timezone.  
     #  
     $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';  
   
     # Hack to deal with 'PST8PDT' format of TZ  
     # Note that this can't deal with all the esoteric forms, but it  
     # does recognize the most common: [:]STDoff[DST[off][,rule]]  
     #  
     if ($TZ =~ /^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/) {  
         $TZ = $isdst ? $4 : $1;  
         $tzoff = sprintf("%05d", -($2) * 100);  
     }  
   
     # perl-4.036 doesn't have the $zone or $gmtoff...  
     ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $zone, $gmtoff) =  
         ($TZ eq 'GMT') ? gmtime(time) : localtime(time);  
   
     $year += ($year < 70) ? 2000 : 1900;  
   
     if ($gmtoff != 0) {  
         $tzoff = sprintf("%05d", ($gmtoff / 60) * 100);  
     }  
     if ($zone ne '') {  
         $TZ = $zone;  
     }  
   
     # ok, let's try....  
     $rfc822date = sprintf("%s, %2d %s %4d %2d:%02d:%02d %s (%s)",  
                           $DoW[$wday], $mday, $MoY[$mon], $year,  
                           $hour, $min, $sec, $tzoff, $TZ);  
   
     open(MAIL, "| $MAILER");  
     print MAIL "Date:     " . $rfc822date . "\n";  
     print MAIL "Subject:  CVS Update: " . $modulename . "\n";  
     print MAIL "To:       " . $mailto . "\n";  
     print MAIL "Reply-To: " . $replyto . "\n";  
     print MAIL "\n";  
     print MAIL join("\n", @text), "\n";  
     close(MAIL);  
367  }  }
368    
 sub write_commitlog {  
     local($logfile, @text) = @_;  
369    
370      open(FILE, ">>$logfile");  sub derive_subject_from_changes_file ()
371      print FILE join("\n", @text), "\n";  {
372      close(FILE);    my $subj = "";
373    
374      for ($i = 0; ; $i++)
375      {
376        open (CH, "<$CHANGED_FILE.$i.$id.$cvs_user") or last;
377    
378        while (my $change = <CH>)
379        {
380          # A changes file looks like this:
381          #
382          #  src      foo.c newfile.html
383          #  www      index.html project_nav.html
384          #
385          # Each line is " Dir File1 File2 ..."
386          # We only care about Dir, since the subject line should
387          # summarize.
388          
389          $change =~ s/^[ \t]*//;
390          $change =~ /^([^ \t]+)[ \t]*/;
391          my $dir = $1;
392          # Fold to rightmost directory component
393          $dir =~ /([^\/]+)$/;
394          $dir = $1;
395          if ($subj eq "") {
396            $subj = $dir;
397          } else {
398            $subj .= ", $dir";
399          }
400        }
401        close (CH);
402      }
403    
404      if ($subj ne "") {
405          $subj = "MODIFIED: $subj ...";
406      }
407      else {
408          # NPM: See if there's any file-addition notifications.
409          my $added = &read_line_nodie("$ADDED_FILE.$i.$id.$cvs_user");
410          if ($added ne "") {
411              $subj .= "ADDED: $added ";
412          }
413        
414    #    print "derive_subject_from_changes_file().. added== $added \n";
415        
416           ## NPM: See if there's any file-removal notications.
417          my $removed = &read_line_nodie("$REMOVED_FILE.$i.$id.$cvs_user");
418          if ($removed ne "") {
419              $subj .= "REMOVED: $removed ";
420          }
421        
422    #    print "derive_subject_from_changes_file().. removed== $removed \n";
423        
424          ## NPM: See if there's any branch notifications.
425          my $branched = &read_line_nodie("$BRANCH_FILE.$i.$id.$cvs_user");
426          if ($branched ne "") {
427              $subj .= "BRANCHED: $branched";
428          }
429        
430    #    print "derive_subject_from_changes_file().. branched== $branched \n";
431        
432          ## NPM: DEFAULT: DIRECTORY CREATION (c.f. "Check for a new directory first" in main mody)
433          if ($subj eq "") {
434              my $subject = join("/", @path);
435              $subj = "NEW: $subject";
436          }    
437      }
438    
439      if ($branch)
440      {
441        $subj = "[$branch] $subj"
442      }
443    
444    
445      return $subj;
446  }  }
447    
448  #  sub mail_notification
449  #       Main Body  {
450  #      local($addr_list, @text) = @_;
451        local ($mail_to, $mail_from);
452    
453  # Initialize basic variables      my $subj = &derive_subject_from_changes_file ();
454    
455        if ($EMULATE_LOCAL_MAIL_USER) {
456          $mail_from = "$cvs_user\@$EMULATE_LOCAL_MAIL_USER";
457        } else {
458          $mail_from = "$cvs_user\@" . `hostname`;
459          chomp $mail_from;
460        }
461    
462        $mail_to = join(", ", @{$addr_list});
463    
464        print "Mailing the commit message to $mail_to (from $mail_from)\n";
465    
466        $ENV{'MAILUSER'} = $mail_from;
467        # Commented out on hocus, so comment it out here.  -kff
468        # $ENV{'QMAILINJECT'} = 'f';
469    
470        open(MAIL, "$MAIL_CMD -f$mail_from");
471        print MAIL "From: $mail_from\n";
472        print MAIL "To: $mail_to\n";
473        print MAIL "Subject: $SUBJECT_PRE $subj\n\n";
474        print(MAIL join("\n", @text));
475        close(MAIL);
476    #    print "Mailing the commit message to $MAIL_TO...\n";
477  #  #
478  $debug = 0;  #    #added by jrobbins@collab.net 1999/12/15
479  $id = getpgrp();                # note, you *must* use a shell which does setpgrp()  #    # attempt to get rid of anonymous
480  $state = $STATE_NONE;  #    $ENV{'MAILUSER'} = 'commitlogger';
481  chop($hostname = `hostname`);  #    $ENV{'QMAILINJECT'} = 'f';
482  chop($domainname = `domainname`);  #
483  if ($domainname !~ '^\..*') {  #    open(MAIL, "| /var/qmail/bin/qmail-inject");
484      $domainname = '.' . $domainname;  #    print(MAIL "To: $MAIL_TO\n");
485  }  #    print(MAIL "Subject: cvs commit: $ARGV[0]\n");
486  $hostdomain = $hostname . $domainname;  #    print(MAIL join("\n", @text));
487  $cvsroot = $ENV{'CVSROOT'};  #    close(MAIL);
488  $do_status = 1;                 # moderately useful  }
489  $show_wd = 0;                   # useless in client/server  
490  $modulename = "";  ## process the command line arguments sent to this script
491    ## it returns an array of files, %s, sent from the loginfo
492  # parse command line arguments (file list is seen as one arg)  ## command
493  #  #
494  while (@ARGV) {  #   -r TAG      - operate only on changes with tag TAG
495      $arg = shift @ARGV;  #   -r BRANCH   - operate only on changes in branch TAG
496    #                 Use -r "" for "only changes with no tag or branch".
497      if ($arg eq '-d') {  #   -u USER     - Set CVS username to USER.
498          $debug = 1;  sub process_argv
499          print STDERR "Debug turned on...\n";  {
500      } elsif ($arg eq '-m') {      local(@argv) = @_;
501          if ($mailto eq '') {      local(@files);
502              $mailto = shift @ARGV;      local($arg);
503          } else {      print "Processing log script arguments...\n";
504              $mailto = $mailto . ", " . shift @ARGV;  
505          }      while (@argv) {
506      } elsif ($arg eq '-R') {          $arg = shift @argv;
507          if ($replyto eq '') {          if ($arg eq '-u' && !defined($cvs_user)) {
508              $replyto = shift @ARGV;              $cvs_user = shift @argv;
509            } elsif ($arg eq '-m') {
510                push @mailto, split (/[ ,]+/, shift @argv);
511            } elsif ($arg eq '-p') {
512                $update_dir = shift @argv;
513            } elsif ($arg eq '-r') {
514                $have_r_opt = 1;
515                $onlytag = shift @argv;
516          } else {          } else {
517              $replyto = $replyto . ", " . shift @ARGV;              ($donefiles) && die "Too many arguments!\n";
518                $donefiles = !$UseNewInfoFmtStrings;
519    
520                if ($arg eq '- New directory') {
521                    $new_directory = 1;
522                } elsif ($arg eq '- Imported sources') {
523                    $imported_sources = 1;
524                } elsif ($UseNewInfoFmtStrings) {
525                    push @file, $arg;
526                    $oldrev{$arg} = shift @argv
527                        or die "Not enough modifiers for $arg";
528                    $newrev{$arg} = shift @argv
529                        or die "Not enough modifiers for $arg";
530                    $oldrev{$arg} = 0 if $oldrev{$arg} eq "NONE";
531                    $newrev{$arg} = 0 if $newrev{$arg} eq "NONE";
532                } else {
533                    push @files, split (' ', $arg);
534                    for (@files)
535                    {
536                        s/,([^,]+),([^,]+)$//
537                            or die "Not enough modifiers for $_";
538                        $oldrev{$_} = $1;
539                        $newrev{$_} = $2;
540                        $oldrev{$_} = 0 if $oldrev{$_} eq "NONE";
541                        $newrev{$_} = 0 if $newrev{$_} eq "NONE";
542                    }
543                }
544          }          }
     } elsif ($arg eq '-M') {  
         $modulename = shift @ARGV;  
     } elsif ($arg eq '-u') {  
         $login = shift @ARGV;  
     } elsif ($arg eq '-s') {  
         $do_status = 0;  
     } elsif ($arg eq '-w') {  
         $show_wd = 1;  
     } elsif ($arg eq '-f') {  
         ($commitlog) && die("Too many '-f' args\n");  
         $commitlog = shift @ARGV;  
     } else {  
         ($donefiles) && die("Too many arguments!  Check usage.\n");  
         $donefiles = 1;  
         @files = split(/ /, $arg);  
545      }      }
546    
547        # Sanity checks.
548        die "No email destination specified.\n" unless @mailto;
549    
550        return @files;
551  }  }
 if ($login eq '') {  
     $login = getlogin || (getpwuid($<))[0] || "nobody";  
 }  
 ($mailto) || die("No mail recipient specified (use -m)\n");  
 if ($replyto eq '') {  
     $replyto = $login;  
 }  
552    
553  # for now, the first "file" is the repository directory being committed,  
554  # relative to the $CVSROOT location  #############################################################
555  #  #
556  @path = split('/', $files[0]);  # Main Body
557    #
558    ############################################################
559    #
560    # Setup environment
561    #
562    umask (002);
563    
564    # Connect to the database
565    $cvsbin = "/usr/bin";
566    
 # XXX There are some ugly assumptions in here about module names and  
 # XXX directories relative to the $CVSROOT location -- really should  
 # XXX read $CVSROOT/CVSROOT/modules, but that's not so easy to do, since  
 # XXX we have to parse it backwards.  
 # XXX  
 # XXX Fortunately it's relatively easy for the user to specify the  
 # XXX module name as appropriate with a '-M' via the directory  
 # XXX matching in loginfo.  
567  #  #
568  if ($modulename eq "") {  # Initialize basic variables
569      $modulename = $path[0];     # I.e. the module name == top-level dir  #
570  }  $id = getpgrp();
571    $state = $STATE_NONE;
572    $cvs_user = $ENV{'USER'} || getlogin || (getpwuid($<))[0] || sprintf("uid#%d",$<);
573    $new_directory = 0;             # Is this a 'cvs add directory' command?
574    $imported_sources = 0;          # Is this a 'cvs import' command?
575    $have_r_opt = 0;                # Whether -r was seen on the command line.
576    $onlytag = "";                  # With $have_r_opt, only send mail for changes
577                                    # on this branch.
578    $branch = "";                   # The branch being processed.
579    @mailto = ();                   # Email addresses to send mail to.
580    $update_dir = "";               # The relative directory in the repo the
581                                    # sandbox is rooted in.
582    @files = process_argv(@ARGV);
583    @path = split('/', $files[0]);
584  if ($#path == 0) {  if ($#path == 0) {
585      $dir = ".";      $dir = ".";
586  } else {  } else {
587      $dir = join('/', @path);      $dir = join('/', @path[1..$#path]);
588  }  }
 $dir = $dir . "/";  
589    
590  if ($debug) {  $update_dir = `cat CVS/Repository` unless $update_dir;
591      print STDERR "module - ", $modulename, "\n";  chomp $update_dir;
592      print STDERR "dir    - ", $dir, "\n";  die "Could not determine update dir" unless $update_dir;
     print STDERR "path   - ", join(":", @path), "\n";  
     print STDERR "files  - ", join(":", @files), "\n";  
     print STDERR "id     - ", $id, "\n";  
 }  
593    
594  # Check for a new directory first.  This appears with files set as follows:  #print("ARGV  - ", join(":", @ARGV), "\n");
595  #  #print("files - ", join(":", @files), "\n");
596  #    files[0] - "path/name/newdir"  #print("path  - ", join(":", @path), "\n");
597  #    files[1] - "-"  #print("dir   - ", $dir, "\n");
598  #    files[2] - "New"  #print("id    - ", $id, "\n");
 #    files[3] - "directory"  
 #  
 if ($files[2] =~ /New/ && $files[3] =~ /directory/) {  
     local(@text);  
   
     @text = ();  
     push(@text, &build_header());  
     push(@text, "");  
     push(@text, $files[0]);  
     push(@text, "");  
599    
     while (<STDIN>) {  
         chop;                   # Drop the newline  
         push(@text, $_);  
     }  
   
     &mail_notification($mailto, @text);  
   
     exit 0;  
 }  
600    
601  # Check for an import command.  This appears with files set as follows:  ##########################
602  #  #
603  #    files[0] - "path/name"  # Check for a new directory first.  This will always appear as a
604  #    files[1] - "-"  # single item in the argument list, and an empty log message.
 #    files[2] - "Imported"  
 #    files[3] - "sources"  
605  #  #
606  if ($files[2] =~ /Imported/ && $files[3] =~ /sources/) {  if ($new_directory) {
607      local(@text);      $header = &build_header;
   
608      @text = ();      @text = ();
609      push(@text, &build_header());      push(@text, $header);
     push(@text, "");  
     push(@text, $files[0]);  
610      push(@text, "");      push(@text, "");
611        push(@text, "  ".$files[0]." - New directory");
612      while (<STDIN>) {      &mail_notification ([@mailto], @text);
         chop;                   # Drop the newline  
         push(@text, $_);  
     }  
   
     &mail_notification(@text);  
   
613      exit 0;      exit 0;
614  }  }
615    
616    #
617  # Iterate over the body of the message collecting information.  # Iterate over the body of the message collecting information.
618  #  #
619  while (<STDIN>) {  while (<STDIN>) {
620      chop;                       # Drop the newline      chomp;                      # Drop the newline
621        if (/^\s*(Tag|Revision\/Branch):\s*(\w+)/) {
622      if (/^In directory/) {          $branch = $2;
623          if ($show_wd) {         # useless in client/server mode          # Is there really a good reason to keep track of this?
624              push(@log_lines, $_);          push (@branch_lines, $2);
625              push(@log_lines, "");          next;
         }  
         next;  
626      }      }
627    #    next if (/^[ \t]+Tag:/ && $state != $STATE_LOG);
628      if (/^Modified Files/) { $state = $STATE_CHANGED; next; }      if (/^Modified Files/) { $state = $STATE_CHANGED; next; }
629      if (/^Added Files/)    { $state = $STATE_ADDED;   next; }      if (/^Added Files/)    { $state = $STATE_ADDED;   next; }
630      if (/^Removed Files/)  { $state = $STATE_REMOVED; next; }      if (/^Removed Files/)  { $state = $STATE_REMOVED; next; }
631      if (/^Log Message/)    { $state = $STATE_LOG;     next; }      if (/^Log Message/)    { $state = $STATE_LOG;     last; }
632        s/[ \t\n]+$//;              # delete trailing space
     s/^[ \t\n]+//;              # delete leading whitespace  
     s/[ \t\n]+$//;              # delete trailing whitespace  
633            
634      if ($state == $STATE_CHANGED) { push(@changed_files, split); }      push (@changed_files, split) if ($state == $STATE_CHANGED);
635      if ($state == $STATE_ADDED)   { push(@added_files,   split); }      push (@added_files,   split) if ($state == $STATE_ADDED);
636      if ($state == $STATE_REMOVED) { push(@removed_files, split); }      push (@removed_files, split) if ($state == $STATE_REMOVED);
637      if ($state == $STATE_LOG)     { push(@log_lines,     $_); }  }
638    # Proces the /Log Message/ section now, if it exists.
639    # Do this here rather than above to deal with Log messages
640    # that include lines that confuse the state machine.
641    if (!eof(STDIN)) {
642        while (<STDIN>) {
643            next unless ($state == $STATE_LOG); # eat all STDIN
644    
645            if ($state == $STATE_LOG) {
646                if (/^PR:$/i ||
647                    /^Reviewed by:$/i ||
648                    /^Submitted by:$/i ||
649                    /^Obtained from:$/i) {
650                    next;
651                }
652                push (@log_lines,     $_);
653            }
654        }
655  }  }
656    
657    #
658  # Strip leading and trailing blank lines from the log message.  Also  # Strip leading and trailing blank lines from the log message.  Also
659  # compress multiple blank lines in the body of the message down to a  # compress multiple blank lines in the body of the message down to a
660  # single blank line.  # single blank line.
661    # (Note, this only does the mail and changes log, not the rcs log).
662  #  #
663  while ($#log_lines > -1) {  while ($#log_lines > -1) {
664      last if ($log_lines[0] ne "");      last if ($log_lines[0] ne "");
# Line 433  while ($#log_lines > -1) { Line 670  while ($#log_lines > -1) {
670  }  }
671  for ($i = $#log_lines; $i > 0; $i--) {  for ($i = $#log_lines; $i > 0; $i--) {
672      if (($log_lines[$i - 1] eq "") && ($log_lines[$i] eq "")) {      if (($log_lines[$i - 1] eq "") && ($log_lines[$i] eq "")) {
673          splice(@log_lines, $i, 1);          splice(@log_lines, $i, 1);
674      }      }
675  }  }
676    
677  if ($debug) {  #
678      print STDERR "Searching for log file index...";  # Find the log file that matches this log message
 }  
 # Find an index to a log file that matches this log message  
679  #  #
680  for ($i = 0; ; $i++) {  for ($i = 0; ; $i++) {
681      local(@text);      last if (! -e "$LOG_FILE.$i.$id.$cvs_user");
682        @text = &read_logfile("$LOG_FILE.$i.$id.$cvs_user", "");
683      last if (! -e "$LOG_FILE.$i.$id"); # the next available one      last if ($#text == -1);
684      @text = &read_logfile("$LOG_FILE.$i.$id", "");      last if (join(" ", @log_lines) eq join(" ", @text));
     last if ($#text == -1);     # nothing in this file, use it  
     last if (join(" ", @log_lines) eq join(" ", @text)); # it's the same log message as another  
 }  
 if ($debug) {  
     print STDERR " found log file at $i.$id, now writing tmp files.\n";  
685  }  }
686    
687    #
688  # Spit out the information gathered in this pass.  # Spit out the information gathered in this pass.
689  #  #
690  &append_names_to_file("$CHANGED_FILE.$i.$id", $dir, @changed_files);  &write_logfile("$LOG_FILE.$i.$id.$cvs_user", @log_lines);
691  &append_names_to_file("$ADDED_FILE.$i.$id",   $dir, @added_files);  &append_to_file("$BRANCH_FILE.$i.$id.$cvs_user",  $dir, @branch_lines);
692  &append_names_to_file("$REMOVED_FILE.$i.$id", $dir, @removed_files);  &append_to_file("$ADDED_FILE.$i.$id.$cvs_user",   $dir, @added_files);
693  &write_logfile("$LOG_FILE.$i.$id", @log_lines);  &append_to_file("$CHANGED_FILE.$i.$id.$cvs_user", $dir, @changed_files);
694    &append_to_file("$REMOVED_FILE.$i.$id.$cvs_user", $dir, @removed_files);
695    if ($rcsidinfo) {
696      &change_summary ("$SUMMARY_FILE.$i.$id.$cvs_user",
697                       (@changed_files, @added_files, @removed_files));
698    }
699    
700    #
701  # Check whether this is the last directory.  If not, quit.  # Check whether this is the last directory.  If not, quit.
702  #  #
703  if ($debug) {  if (-e "$LAST_FILE.$id.$cvs_user") {
704      print STDERR "Checking current dir against last dir.\n";     $_ = &read_line("$LAST_FILE.$id.$cvs_user");
705       $tmpfiles = $files[0];
706       $tmpfiles =~ s,([^a-zA-Z0-9_/]),\\$1,g;
707       if (! grep(/$tmpfiles$/, $_)) {
708            print "More commits to come...\n";
709            exit 0
710       }
711  }  }
 $_ = &read_line("$LAST_FILE.$id");  
712    
 if ($_ ne $cvsroot . "/" . $files[0]) {  
     if ($debug) {  
         print STDERR sprintf("Current directory %s is not last directory %s.\n", $cvsroot . "/" .$files[0], $_);  
     }  
     exit 0;  
 }  
 if ($debug) {  
     print STDERR sprintf("Current directory %s is last directory %s -- all commits done.\n", $files[0], $_);  
 }  
   
 #  
 #       End Of Commits!  
713  #  #
   
714  # This is it.  The commits are all finished.  Lump everything together  # This is it.  The commits are all finished.  Lump everything together
715  # into a single message, fire a copy off to the mailing list, and drop  # into a single message, fire a copy off to the mailing list, and drop
716  # it on the end of the Changes file.  # it on the end of the Changes file.
717  #  #
718    $header = &build_header;
719    
720  #  #
721  # Produce the final compilation of the log messages  # Produce the final compilation of the log messages
722  #  #
723  @text = ();  @text = ();
724  @status_txt = ();  push(@text, $header);
 push(@text, &build_header());  
725  push(@text, "");  push(@text, "");
   
726  for ($i = 0; ; $i++) {  for ($i = 0; ; $i++) {
727      last if (! -e "$LOG_FILE.$i.$id"); # we're done them all!      last if (! -e "$LOG_FILE.$i.$id.$cvs_user");
728      @lines = &read_logfile("$CHANGED_FILE.$i.$id", "");      push(@text, &read_file("$BRANCH_FILE.$i.$id.$cvs_user", "Branch:"));
729      if ($#lines >= 0) {      push(@text, &read_file("$CHANGED_FILE.$i.$id.$cvs_user", "Modified:"));
730          push(@text, "Modified files:");      push(@text, &read_file("$ADDED_FILE.$i.$id.$cvs_user", "Added:"));
731          push(@text, &format_lists(@lines));      push(@text, &read_file("$REMOVED_FILE.$i.$id.$cvs_user", "Removed:"));
732      }      push(@text, "  Log:");
733      @lines = &read_logfile("$ADDED_FILE.$i.$id", "");      push(@text, &read_logfile("$LOG_FILE.$i.$id.$cvs_user", "  "));
734      if ($#lines >= 0) {      if ($rcsidinfo == 2) {
735          push(@text, "Added files:");          if (-e "$SUMMARY_FILE.$i.$id.$cvs_user") {
736          push(@text, &format_lists(@lines));              push(@text, "  ");
737      }              push(@text, "  Revision  Changes    Path");
738      @lines = &read_logfile("$REMOVED_FILE.$i.$id", "");              push(@text, &read_logfile("$SUMMARY_FILE.$i.$id.$cvs_user", "  "));
739      if ($#lines >= 0) {          }
         push(@text, "Removed files:");  
         push(@text, &format_lists(@lines));  
     }  
     if ($#text >= 0) {  
         push(@text, "");  
     }  
     @lines = &read_logfile("$LOG_FILE.$i.$id", "\t");  
     if ($#lines >= 0) {  
         push(@text, "Log message:");  
         push(@text, @lines);  
         push(@text, "");  
     }  
     if ($do_status) {  
         local(@changed_files);  
   
         @changed_files = ();  
         push(@changed_files, &read_logfile("$CHANGED_FILE.$i.$id", ""));  
         push(@changed_files, &read_logfile("$ADDED_FILE.$i.$id", ""));  
         push(@changed_files, &read_logfile("$REMOVED_FILE.$i.$id", ""));  
   
         if ($debug) {  
             print STDERR "main: pre-sort changed_files = ", join(":", @changed_files), ".\n";  
         }  
         sort(@changed_files);  
         if ($debug) {  
             print STDERR "main: post-sort changed_files = ", join(":", @changed_files), ".\n";  
         }  
   
         foreach $dofile (@changed_files) {  
             if ($dofile =~ /\/$/) {  
                 next;           # ignore the silly "dir" entries  
             }  
             if ($debug) {  
                 print STDERR "main(): doing 'cvs -nQq status -v $dofile'\n";  
             }  
             open(STATUS, "-|") || exec 'cvs', '-nQq', 'status', '-v', $dofile;  
             while (<STATUS>) {  
                 chop;  
                 push(@status_txt, $_);  
             }  
         }  
740      }      }
741        push(@text, "");
742  }  }
743    
 # Write to the commitlog file  
744  #  #
745  if ($commitlog) {  # Now generate the extra info for the mail message..
746      &write_commitlog($commitlog, @text);  #
747    if ($rcsidinfo == 1) {
748        $revhdr = 0;
749        for ($i = 0; ; $i++) {
750            last if (! -e "$LOG_FILE.$i.$id.$cvs_user");
751            if (-e "$SUMMARY_FILE.$i.$id.$cvs_user") {
752                if (!$revhdr++) {
753                    push(@text, "Revision  Changes    Path");
754                }
755                push(@text, &read_logfile("$SUMMARY_FILE.$i.$id.$cvs_user", ""));
756            }
757        }
758        if ($revhdr) {
759            push(@text, "");        # consistancy...
760        }
761  }  }
762    
 if ($#status_txt >= 0) {  
     push(@text, @status_txt);  
 }  
763    
 # Mailout the notification.  
 #  
 &mail_notification(@text);  
764    
 # cleanup  
765  #  #
766  if (! $debug) {  # Mail out the notification.
767      &cleanup_tmpfiles();  #
768    if (!$have_r_opt || $onlytag eq $branch) {
769        &mail_notification ([@mailto], @text);
770  }  }
771    &cleanup_tmpfiles;
772  exit 0;  exit 0;

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26