cvs-cvs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Cvs-cvs] ccvs/contrib log_accum.pl


From: Derek Robert Price
Subject: [Cvs-cvs] ccvs/contrib log_accum.pl
Date: Thu, 11 May 2006 23:10:43 +0000

CVSROOT:        /cvsroot/cvs
Module name:    ccvs
Branch:         
Changes by:     Derek Robert Price <address@hidden>     06/05/11 23:10:38

Modified files:
        contrib        : log_accum.pl 

Log message:
        * log_accum.pl: Gradually restoring functionality.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/cvs/ccvs/contrib/log_accum.pl.diff?tr1=1.20&tr2=1.21&r1=text&r2=text

Patches:
Index: ccvs/contrib/log_accum.pl
diff -u ccvs/contrib/log_accum.pl:1.20 ccvs/contrib/log_accum.pl:1.21
--- ccvs/contrib/log_accum.pl:1.20      Thu May 11 19:56:35 2006
+++ ccvs/contrib/log_accum.pl   Thu May 11 23:10:32 2006
@@ -157,87 +157,6 @@
 #
 ############################################################
 
-sub cleanup_tmpfiles {
-    my ($tmpdir, $prefix, $id) = @_;
-    my @files;
-
-    die "$tmpdir does not exist" unless -d $tmpdir;
-    opendir DIR, $tmpdir or die "Can't read $tmpdir";
-
-    push @files, grep /^#\Q$prefix\E\.$id.*\.$/, readdir DIR;
-    closedir DIR;
-
-    foreach (@files)
-    {
-        unlink "$tmpdir/$_";
-    }
-}
-
-sub write_line {
-    my ($filename, $line) = @_;
-
-    open(FILE, ">$filename") || die("Cannot open file $filename: $!\n");
-    print(FILE $line, "\n");
-    close(FILE);
-}
-
-sub append_line {
-    my ($filename, $line) = @_;
-
-    open(FILE, ">>$filename") || die("Cannot open file $filename: $!\n");
-    print(FILE $line, "\n");
-    close(FILE);
-}
-
-sub read_line {
-    my ($filename) = @_;
-    my ($line);
-
-    open(FILE, "<$filename") || die("Cannot open file $filename: $!\n");
-    $line = <FILE>;
-    close(FILE);
-    chomp($line);
-    $line;
-}
-
-sub read_line_nodie {
-    my ($filename) = @_;
-    my ($line);
-    open(FILE, "<$filename") || return ("");
-
-    $line = <FILE>;
-    close(FILE);
-    chomp($line);
-    $line;
-}
-
-sub read_file_lines {
-    my ($filename) = @_;
-    my (@text) = ();
-
-    open(FILE, "<$filename") || return ();
-    while (<FILE>) {
-        chomp;
-        push(@text, $_);
-    }
-    close(FILE);
-    @text;
-}
-
-sub read_file {
-    my ($filename, $leader) = @_;
-    my (@text) = ();
-
-    open(FILE, "<$filename") || return ();
-    while (<FILE>) {
-        chomp;
-        push(@text, sprintf("  %-10s  %s", $leader, $_));
-        $leader = "";
-    }
-    close(FILE);
-    @text;
-}
-
 # FIXME: Temporarily disabled.
 #
 # do an 'cvs -Qn status' on each file in the arguments, and extract info.
@@ -337,78 +256,6 @@
 
 
 
-sub derive_subject_from_changes_file
-{
-    my ($BRANCH_FILE, $CHANGED_BASE, $ADDED_BASE, $REMOVED_BASE, $module) = @_;
-    my $subj = "";
-
-    my $i;
-    for ($i = 0; ; $i++)
-    {
-       open CH, "<$CHANGED_BASE.$i" or last;
-
-       while (<CH>)
-       {
-           # A changes file looks like this:
-           #
-           #  src      foo.c newfile.html
-           #  www      index.html project_nav.html
-           #
-           # Each line is " Dir File1 File2 ..."
-           # We only care about Dir, since the subject line should
-           # summarize. 
-
-           s/^[ \t]*//;
-           /^([^ \t]+)[ \t]*/;
-           my $dir = $1;
-           # Fold to rightmost directory component
-           $dir =~ /([^\/]+)$/;
-           $dir = $1;
-           if ($subj eq "")
-           {
-               $subj = $dir;
-           }
-           else
-           {
-               $subj .= ", $dir"; 
-           }
-       }
-    close CH;
-    }
-
-    if ($subj ne "")
-    {
-      $subj = "MODIFIED: $subj ..."; 
-    }
-    else
-    {
-       # NPM: See if there's any file-addition notifications.
-       my $added = read_line_nodie "$ADDED_BASE.$i";
-       $subj .= "ADDED: $added " if $added ne "";
-
-       #    print "derive_subject_from_changes_file().. added== $added \n";
-
-       ## NPM: See if there's any file-removal notications.
-       my $removed = read_line_nodie "$REMOVED_BASE.$i";
-       $subj .= "REMOVED: $removed " if $removed ne "";
-
-       #    print "derive_subject_from_changes_file().. removed== $removed \n";
-
-       ## NPM: DEFAULT: DIRECTORY CREATION (c.f. "Check for a new directory 
first" in main mody)
-       $subj = "NEW: $module" if $subj eq "";
-    }
-
-    my $branch = read_line_nodie "$BRANCH_FILE.$i";
-    $subj = "$subj [$branch]" if $branch;
-
-    return $subj;
-}
-
-
-
-
-
-
 #######              ######
 #######   REVIEWED   ######
 #######              ######
@@ -766,12 +613,9 @@
 
 sub mail_notification
 {
-    my ($BRANCH_FILE, $CHANGED_BASE, $ADDED_BASE, $REMOVED_BASE,
-       $addr_list, $module, $username, $fullname, $mailfrom, @text) = @_;
+    my ($addr_list, $module, $username, $fullname, $mailfrom,
+       $subject, @text) = @_;
 
-    my $subj = derive_subject_from_changes_file ($BRANCH_FILE, $CHANGED_BASE,
-                                                $ADDED_BASE, $REMOVED_BASE,
-                                                $module);
     my $mail_to = join ", ", @$addr_list;
 
     my @mailcmd;
@@ -794,7 +638,7 @@
     print MAIL "To: $mail_to\n";
     # $fullname may be empty, but the extra spaces won't hurt.
     print MAIL "From: $fullname <$mailfrom>\n" if $mailfrom;
-    print MAIL "Subject: $subj\n";
+    print MAIL "Subject: $subject\n";
     print MAIL "\n";
     print MAIL join "\n", @text;
 
@@ -887,29 +731,75 @@
 
 
 
-sub accum_subject
+sub compile_subject
 {
-    my @lines = @_;
-    my (@files, $dir);
+    my ($branch, @list) = @_;
+    my $text;
 
-    $dir = shift @lines;       # first thing is always a directory
-    die "Damn, $dir doesn't look like a directory!\n" if $dir !~ m#.*/$#;
+    # This uses the simplifying assumptions that no dir is equal to `' or `.'
+    # and that all directories have been normalized,  This is okay because
+    # commit_prep rejects the toplevel project as input and all the directory
+    # names were normalized before being written to the change files.
 
-    @files = ($dir);
-    foreach my $line (@lines)
+    print STDERR "compile_subject(): ", $branch ? "[$branch] " : "",
+                join (":", @list), "\n"
+       if $debug;
+
+    # Find the highest common directory.
+    my @dirs = grep m#/$#, @list;
+    map s#/$##, @dirs;
+    my @topsplit = split m#/#, $dirs[0];
+    for (my $i = 1; $i <= $#dirs; $i++)
     {
-       if ($line =~ m#.*/$#)
+       my @dirsplit = split m#/#, $dirs[$i];
+       for (my $j = 0; $j <= $#topsplit and $j <= $#dirsplit; $j++)
        {
-           $dir = $line;
-           push @files, $line;
+           if ($topsplit[$j] ne $dirsplit[$j])
+           {
+               splice @topsplit, $j;
+               last;
+           }
        }
-       else
+       last unless @topsplit;
+    }
+
+    my $topdir = join "/", @topsplit;
+    # $topdir may be empty.
+
+    # strip out directories and the common prefix $topdir.
+    my $offset = length $topdir;
+    $offset++ if $offset > 0;
+
+    my @out;
+    push @out, $topdir if $topdir;
+
+    
+    my $dir = shift @list;
+    die "Darn, $dir doesn't look like a directory!" unless $dir =~ s#/$##;
+    $dir = substr $dir, $offset;
+
+    # Build the list of files with directories prepended.
+    foreach (@list)
+    {
+       if (m#/$#)
        {
-           push @files, $dir . $line;
+           $dir = $_;
+           $dir = substr $dir, $offset;
+           next;
        }
+
+       my $file = "$dir$_";
+       $file = "`$file'" if $file =~ /\s/;
+       push @out, $file;
     }
 
-    return @files;
+    # put it together and limit the length.
+    $text = join " ", @out;
+    substr $text, 47, length ($text), "..." if length ($text) > 50;
+
+    $text .= " [$branch]" if $branch;
+
+    return $text;
 }
 
 
@@ -919,7 +809,7 @@
     my ($filename) = @_;
     my @text;
 
-    open FILE, "<$filename" or die "Cannot open log file $filename: $!\n";
+    open FILE, "<$filename" or die "Cannot open log file $filename: $!";
     while (<FILE>)
     {
         chomp;
@@ -941,7 +831,7 @@
     {
        push @$text, $section;
        push @$text, format_lists $toplevel, @lines;
-       push @$subject_files, accum_subject @lines if $subject_files;;
+       push @$subject_files, @lines if $subject_files;
     }
 }
 
@@ -953,7 +843,7 @@
 
     if (@files)
     {
-       open FILE, ">>$filename" or die "Cannot open file $filename: $!\n";
+       open FILE, ">>$filename" or die "Cannot open file $filename: $!";
        print FILE $dir, "/\n";
        print FILE join ("\n", @files), "\n";
        close FILE;
@@ -964,8 +854,10 @@
 
 sub build_message_body
 {
-    my ($toplevel, $changed_file, $added_file, $removed_file, $log_file) = @_;
-    my (@body, @subject_files, @log_text);
+    my ($toplevel, $branch,
+       $changed_file, $added_file, $removed_file, $log_file) = @_;
+    my ($subject, @body, @log_text);
+    my @subject_files;
 
     push_formatted_lists address@hidden, address@hidden, $toplevel,
                         "Modified files:", $changed_file;
@@ -980,7 +872,9 @@
     push @body, @log_text;
     push @body, "";
 
-    return address@hidden, address@hidden, address@hidden;
+    $subject = compile_subject $branch, @subject_files;
+
+    return $subject, address@hidden, address@hidden;
 }
 
 
@@ -989,13 +883,46 @@
 {
     my ($filename, @lines) = @_;
 
-    open FILE, ">$filename" or die "Cannot open log file $filename: $!\n";
+    open FILE, ">$filename" or die "Cannot open log file $filename: $!";
     print FILE join ("\n", @lines), "\n";
     close FILE;
 }
 
 
 
+sub cleanup_tmpfiles
+{
+    my ($tmpdir, $prefix, $id) = @_;
+    my @files;
+
+    die "$tmpdir does not exist" unless -d $tmpdir;
+    opendir DIR, $tmpdir or die "Can't read $tmpdir: $!";
+
+    push @files, grep /^#\Q$prefix\E\.$id.*\.$/, readdir DIR;
+    closedir DIR;
+
+    foreach (@files)
+    {
+        unlink "$tmpdir/$_";
+    }
+}
+
+
+
+sub read_line
+{
+    my ($filename) = @_;
+    my $line;
+
+    open FILE, "<$filename" or die "Cannot open file $filename: $!";
+    $line = <FILE>;
+    close FILE;
+    chomp $line;
+    return $line;
+}
+
+
+
 #############################################################
 #
 # Main Body
@@ -1033,14 +960,14 @@
     # Check for a new directory first.  This will always appear as a
     # single item in the argument list, and an empty log message.
     #
-    if ($new_directory) {
+    if ($new_directory)
+    {
        my @header = build_header $toplevel, "",
                                  $username, $fullname, $mailname;
-       my @text;
-       push @text, "  $module - New directory";
-       mail_notification $BRANCH_FILE, $CHANGED_BASE, $ADDED_BASE,
-                         $REMOVED_BASE, address@hidden, $module, $username,
-                         $fullname, $mailname, @header, @text;
+       my @body;
+       push @body, "  $module - New directory";
+       mail_notification address@hidden, $module, $username, $fullname, 
$mailname,
+                         $module, @header, @body;
        exit 0;
     }
 
@@ -1104,20 +1031,20 @@
     my @header = build_header $toplevel, $branch_lines->[0],
                              $username, $fullname, $mailname;
 
-    for (my $i = 0; ; $i++)
+    for ($i = 0; ; $i++)
     {
        last if !-e "$LOG_BASE.$i";
 
-       my ($body, $subject_files, $log_text) =
-           build_message_body $toplevel, "$CHANGED_BASE.$i", "$ADDED_BASE.$i",
+       my ($subject, $body, $log_text) =
+           build_message_body $toplevel, $branch_lines->[0],
+                              "$CHANGED_BASE.$i", "$ADDED_BASE.$i",
                               "$REMOVED_BASE.$i", "$LOG_BASE.$i";
 
        #
        # Mail out the notification.
        #
-       mail_notification $BRANCH_FILE, $CHANGED_BASE, $ADDED_BASE,
-                         $REMOVED_BASE, address@hidden, $module, $username,
-                         $fullname, $mailname, @header, @$body
+       mail_notification address@hidden, $module, $username, $fullname, 
$mailname,
+                         $subject, @header, @$body
            if !$use_onlytag || $onlytag eq $branch_lines->[0];
     }
 




reply via email to

[Prev in Thread] Current Thread [Next in Thread]