#!/usr/local/bin/perl

#----------------------------------------------------------------------
# Author: Jens Klöcker <jkloecker@ets-online.de>
# Created: 2001-02-19
# $Id: logmail,v 1.17 2002/05/30 13:00:38 jens Exp $
# Description: Send log mails from CVS using the CVSROOT/users
#              file for cvs user--real name mapping
#----------------------------------------------------------------------
#
# Copyright (C) 2001 by ets GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
# USA.
#----------------------------------------------------------------------

use Mail::Mailer;
use MIME::QuotedPrint;
use strict;

#--------------
# configuration
#--------------

# CVSROOT environment variable
my $cvsroot = $ENV{'CVSROOT'} or
    die "Unable to detect CVSROOT!\n";

# figure out who is commiting
my $author = ($ENV{'USER'} or 
	      getlogin or 
	      (getpwuid($<))[0] or 
	      "nobody");

# SMTP server to use
my $smtpserver  = "raptor";

# sender address (CVS administrator) if no user address can be found
my $from    = 'jkloecker@ets-online.de';

my $subject_prefix = 'CVS update:';

# mail sending type (smtp, mail, sendmail, test)
my $mailtype    = "smtp";

# user mapping file
my $userfile = "$cvsroot/CVSROOT/users";

# cvs log command to find out the branch
my $cvsstatcmd = '/opt/cvs/bin/cvs -nQq status -v';

#-------------------------------------------------------
# /configuration -- you should not change anything below
#-------------------------------------------------------

# parse command line arguments

my $users = [];
my $donefiles;
my $names_with_branches;
my @files;

while (@ARGV) {
  my $arg = shift @ARGV;

  if ($arg eq '-m') {
    push (@$users, shift @ARGV);
  }
  elsif ($arg eq '-u') {
    $from = shift @ARGV;
  }
  elsif ($arg eq '-b') {
    $names_with_branches = 1;
  }
  else {
    $donefiles and die "Too many arguments!\n";
    $donefiles = 1;
    @files = split(/ /, $arg);
  }
}

# the first argument is the module location relative to $CVSROOT
my $modulepath = shift @files;

# detect directory-changes via "-" file names
@files = ("--") if $files[0] eq "-";

# construct mail subject
my $subject = "$subject_prefix $modulepath";

# construct and apply the user mapping
my $usermap = &maybe_read_user_map_file ();

if (defined ($usermap->{$author}) and $usermap->{$author}) {
  $author = $usermap->{$author};
  $from = encode_header($author);
}

# find out branch information and record them in the subject an for
# use in the email header

my %branches;
my $branches = '--';

if ($files[0] ne '--') {

  foreach my $file (@files) {
    my $branch = '';

    open (CVS, "$cvsstatcmd $file |")
	or die "Can't run cvs command: $!\n";
    while (<CVS>) {
      if (/Sticky\s+Tag:\s+(\S+)/) {
	$branch = $1;
	$branches{$branch} = 1;
	last;
      }
    }
    close CVS;

    $file .= " ($branch)" if ($branch and $names_with_branches);
  }

  $branches = %branches ? join (", ", keys %branches) : 'trunk';
  $subject .= " ($branches)";

}

# join all file names
my $nice_files = join (",\n|             ", @files);

# catch the log message and throw away everything else

my $log_message_seen;
my $log_message;

while (<>) {
  if (/^log message:$/i) {
    $log_message_seen = 1;
  }
  elsif ($log_message_seen) {
    $log_message .= $_;
  }
}

$log_message or $log_message = "[Empty]";

# now we can construct the message body

my $body = <<"_EOT_";
+------------------------------------------------[CVS Update]
| CVS-Author: $author
| Module:     $modulepath
| Branch:     $branches
| Files:      $nice_files
+------------------------------------------------------------

Log Message:

$log_message

_EOT_

# send the email if at least one user could be found

if (exists $users->[0]) {

  my $mailer = Mail::Mailer->new ($mailtype, Server => $smtpserver) or
      die "Unable to create new mailer object:$!\n";

  $mailer->open({From => $from,
		 To => $users,
		 Precedence => 'bulk',
		 'MIME-Version' => '1.0',
		 'Content-Type' => 'text/plain; charset=ISO-8859-1',
		 'Content-Transfer-Encoding' => '8bit',
		 Subject => $subject}) or
		     die "Unable to populate mailer object:$!\n";

  print $mailer $body;

  $mailer->close;
}

#-------------------------------------------------------
# The next sub is "borrowed" from Karl Fogl's cvs2log.pl

sub maybe_read_user_map_file () {
  my %expansions;

  if ($userfile) {
    open (MAPFILE, "<$userfile")
        or die ("Unable to open $userfile: $!)");

    while (<MAPFILE>) {
      next if /^\s*\#/;  # Skip comment lines.
      next if not /:/;   # Skip lines without colons.

      # It is now safe to split on ':'.
      my ($username, $expansion) = split ':';
      chomp $expansion;
      $expansion =~ s/^'(.*)'$/$1/;
      $expansion =~ s/^"(.*)"$/$1/;

      # If it looks like the expansion has a real name already, then
      # we toss the username we got from CVS log.  Otherwise, keep
      # it to use in combination with the email address.

      if ($expansion =~ /^\s*<{0,1}\S+@.*/) {
        # Also, add angle brackets if none present
        if (! ($expansion =~ /<\S+@\S+>/)) {
          $expansions{$username} = "$username <$expansion>";
        }
        else {
          $expansions{$username} = "$username $expansion";
        }
      }
      else {
        $expansions{$username} = $expansion;
      }
    }
    close (MAPFILE);
  }

  return \%expansions;
}

sub encode_header {
  # If necessary, QP encode words according to RFC 2047
  my @words   = split /\s+/, shift;
  my @results = ();

  foreach my $word (@words) {
    if ($word =~ /[^[:alpha:]\<\>\.\@\_\-]/) {
      $word = '=?ISO-8859-1?Q?' . encode_qp($word) . '?=';
    }
    push @results, $word;
  }

  return join " ", @results;
}

exit 0;