#!/usr/local/bin/perl

require 5.004;

use CGI qw(:html escapeHTML);
use ClearCase::Argv;
use Cwd qw(cwd);
use Net::SMTP;
use File::Basename qw(fileparse);
use Getopt::Long;

ClearCase::Argv->attropts;	# parse -/dbg=1 et al

my $prog = (split('/', $0))[-1];

sub usage {
   my $status = shift;
   select($status ? STDERR : STDOUT);
   print <<EOF;
Usage: $prog [flags] pname-in-vob ...
Flags: [default]
   -help	Show this message
   -auto	Read command line(s) from attributes on \$0
   -filter /RE/	In -auto mode, skip commands not matching this Perl pattern
   -mail	Send results via email [stdout]
   -empty	Send mail even for projects with no changes [skip]
   -branch br   Show changes on specified branch [any]
   -to addr,...	Specify mail distribution [\$LOGNAME]
   -inhtml      Output to be embedded in existing HTML; skip headers/footers
   -plain       Generate plain-text output [HTML]
   -view tag	Work in specified view [current]
   -since  date	Changes since specified date, eg 10-Oct.8:00 ['yesterday']
   -before date	No changes after specified date [none]
   -report n	Specify that this report is to be marked as #n [none]
   -type d|f	Restrict changes found to files or directories [either]
   -user login  Show changes only by specified user(s) [all]
   -fhref href  Format changed files as <A HREF=<href>file</A>.

Use "perldoc $0" for full documentation.
EOF
   exit $status;
}

use strict;

my %opt;
GetOptions(\%opt, qw(auto before=s branch=s domain=s empty filter=s
		    fhref=s help inhtml mail! plain report=s
		    since=s to=s type=s@ user=s@ view=s)) || exit 2;

usage(0) if $opt{help};
usage(2) if @ARGV && $opt{auto};

$opt{mail} = 1 if !defined($opt{mail}) && $opt{to}; # -mail is implied by -to

$opt{filter} =~ s%^/(.*)/$%$1% if $opt{filter}; # so RE can be given as /RE/

# Make sure $0 is the full path to this executable.
$0 = join('/', cwd(), $0) unless $0 =~ m%^[/\\]%;

# Make a cleartool object to work through
my $ct = ClearCase::Argv->new({-autochomp=>1, -autofail=>1});

# Determine the working view. This should be a simple main/LATEST cspec.
my $vtag = $opt{view};
if (!$vtag) {
    if ($ENV{CLEARCASE_ROOT}) {
	$vtag = (split '/', $ENV{CLEARCASE_ROOT})[-1];
    } elsif ($0 =~ m%^/view/([^/]+)/%) {
	$vtag = $1;
    }
}
die "$prog: Error: no view context specified\n" unless $vtag;

# If in auto mode, act as our own harness and fire off command lines
# based on CCrxx attributes.
if ($opt{auto}) {
    # Check the CC attributes on this script for all attributes
    # matching /^CCr*/.  These control what we will do from here.
    my @ccrs = $ct->desc([qw(-aattr -all)], "$0@@")->qx;
    my(%reports, %subs);
    for my $attr (@ccrs[2..$#ccrs]) {
	my($key, $val, $name);
	(undef, $key, $val) = split(/[\s=]+/, $attr, 3);
	next unless $key =~ s/^CCr//;
	$val =~ s/^"(.*)"$/$1/;
	if ($key =~ /^(\d+)/) {
	    my $rpt = $1;
	    next if $opt{filter} && ($rpt !~ /$opt{filter}/);
	    $reports{$rpt} = $val;
	} elsif ($key =~ /^[^_]*_(.*)/) {
	    $subs{$1} = $val;
	}
    }
    my $rc = 0;
    for (sort {$a <=> $b} keys %reports) {
	my $name = $_;
	while ($reports{$name} =~ /\{(\w+)\}/) {
	    my $sub = $1;
	    $reports{$name} =~ s/\{$sub\}/$subs{$sub}/g
			    || die "$prog: Error: no match for {$sub}";
	}
	my $explicit = "-report $name -view $vtag";
	if (defined($opt{mail}) && !$opt{mail}) {
	    $explicit .= ' -nomail';
	} elsif ($opt{mail}) {
	    $explicit .= $opt{to} ? " -to $opt{to}" : ' -mail';
	}
	my $cmd = "$^X -S $0 $reports{$name} $explicit";
	$cmd = "set -x; $cmd" if $ct->dbglevel;
	$rc ||= system $cmd;
    }
    exit $rc;
}

# Determine some "ct find" predicates for time slice and user.
my $Since = $opt{since};		# want all changes since this date ...
if (!defined($Since)) {		# default to 'this time yesterday'
   my @mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
   my @s = localtime(time - 24*60*60);
   $Since = sprintf "%02d-%3s-%04d.00:00:00", $s[3], $mon[$s[4]], $s[5]+1900;
}
my $Pred = "created_since($Since)";
my $Before = $opt{before};		# but not after this date (if given)
if (!defined($Before)) {
   my @n = localtime(time);
   my @mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
   $Before = sprintf "%02d-%3s-%04d.%02d:%02d:00",
      $n[3], $mon[$n[4]], $n[5]+1900, $n[2], $n[1];;
}
$Pred .= " && !created_since($opt{before})" if $opt{before};
if ($opt{user}) {
   $Pred .= ' && (';
   for (@{$opt{user}}) {
      for (split(/[\s,]+/)) {
	 $Pred .= "created_by($_)";
	 $Pred .= ' || ';
      }
   }
   $Pred =~ s/\s+\|\|\s$/)/;
}

# Must go into "ipc" mode in order to retain setview/cd/etc state.
$ct->ipc_cleartool(3);

# First we need a view to work through.
$ct->setview($vtag)->system;

my(%Changers, %Files);

my $All_Branch = '(ALL)';

# Obtain the list of known vobs so we can later map a dir to its vob.
my @KnownVobs = $ct->lsvob(['-s'])->qx;

# Makes tail -f of output file easier when testing.
$| = 1;

# "Paragraph mode" - causes chomp to remove multiple trailing \n
$/ = '';

# If no branch specified, report on all.
my $branch = $opt{branch} || $All_Branch;

my $title = "[$opt{report}]: " if $opt{report};
$title .= "Changes on branch $branch in @ARGV";
if ($opt{since} || $opt{before}) {
    $title .= ' ';
    $title .= "before $opt{before}" if $opt{before};
    $title .= ' and ' if $opt{before} && $opt{since};
    $title .= "since $opt{since}" if $opt{since};
} else {
    chomp(my $date = `date '+%a %d-%b-%y'`);
    $title .= " for $date";
}

for my $dir (@ARGV) {
    # Map the requested directory into its containing vob.
    my $vob;
    for (@KnownVobs) { $vob = $_, last if $dir =~ m%$_% };
    die "$prog: Error: no VOB found for $dir\n" unless $vob;

    # Now the vob needs to be mounted and the child process must
    # be cd-ed to the the appropriate area within it. This assumes
    # the $vtag view has /main/LATEST access to it.
    $ct->mount($vob)->system if ! -d "/view/$vtag/$vob/lost+found";
    $ct->cd($dir)->system;

    # Get the basic list of modified elements.
    # It's faster to get all elements in the vob using ct find -all
    # and grep out what we don't want than to do what might seem
    # more natural: "ct find ." alone.
    my $find;
    my @sel = $opt{type} ? ('-type', $opt{type}) : ();
    if ($branch eq $All_Branch) {
	$find = "find . -all @sel -ver '$Pred' -print";
    } else {
	$find = "find . -all @sel -ver 'brtype($branch) && $Pred' -print";
    }

    # Now, for each changed elem we run two 'cleartool describe' cmds:
    # one to get the data on the elem itself and another for the comment.
    for my $version (sort grep m%$dir%, $ct->argv($find)->qx) {

	# Ignore zero-branches and checked-out elements.
	$version =~ m+/CHECKEDOUT$|/0$+ && next;

	# Skip anything in a 'private' subdirectory.
	$version =~ m+/private/|/trigtest/+ && next;

	# Get the raw data about this version and clean it up a bit.
	my($line) = $ct->argv("desc -fmt \"%d===%Fu===%a===%l===%En@@%Sn\\n\" '$version'")->qx;
	next if $?;
	my($date, $name, $attrs, $labels, $xpn) = split /===/, $line;

	# Separate the version-extended pathname into path and version.
	my($pn, $vers) = ($xpn =~ m%(.*)@@(.*)%);

	# Due to a bug in ClearCase/NT, changes made on NT sometimes
	# come over as being by 'username', not by 'fullname' (ie the
	# 1st passwd field instead of the 5th, because CC doesn't map
	# it at checkin time). So we work around that here.
	if (my $tmp = (getpwnam(lc($name)))[5]) {
	    $name = $tmp;
	}

	# Normalize the username since we'll be using it as part of a key.
	$name =~ s/,.*//;
	$name =~ s/[\s.]+/ /g;

	# Make an entry for this user indicating that we've seen him/her.
	$Changers{lc($name)} = $name;

	# Simplify the pathname to remove version-extended subdirs
	# for readability.
	$pn =~ s%@@.*?/\d+/%/%g; 
	#$pn =~ s%(@@)?/main/.*?(CHECKEDOUT\.)?\d+/%/%g;

	# Get the comment and format it correctly.
	my $cmt = $ct->argv("desc -fmt \"%c\\n\" '$version'")->qx;
	next if $?;

	# If the comment contains a line ending with ~p we
	# consider it to be intentionally private.
	# Useful when testing triggers etc.
	next if $cmt =~ /~p$/mi;

	# Ignore attributes users aren't interested in.
	{ local $^W=0; $attrs =~ s/(,\s)?_\w+=".+?"(,\s)?/$2/g; }

	# Now we use the {who,attrs,comment} as the key in a
	# a hash pointing to the names of changed files.
	# Show the date for each change, unless it's guaranteed
	# to be yesterday.

	# Strip years and seconds from date; nobody cares about that.
	$date =~ s/^(\d+-\w+)-\d+\.(\d+:\d+):\d+/$1.$2/;

	# Build up the line to print for this modified file.
	# Labels go at the end because there might not be any.
	my $ln;
	if ($opt{plain}) {
	    $ln = sprintf("%-60s  - %-16s  %-14s  %s",
	    $pn, $vers, $date, $labels);
	} else {
	    my($base,$path,$ext) = fileparse($pn, '\..*?');
	    if ($opt{fhref}) {
		my $flnk;
		if (-d "/view/$vtag$pn") {
		    $flnk = font({color=>"green"}, $pn);
		} else {
		    $flnk = qq($path<a href="$opt{fhref}?file=/view/$vtag$pn\@\@$vers" target="_blank"><b>$base</b></a><a href="$opt{fhref}?render=yes&file=/view/$vtag$pn\@\@$vers" target="_blank"><b>$ext</b></a>);
		}
		my $dlnk = qq(<a href="$opt{fhref}?diff=/view/$vtag$pn\@\@$vers" target="_blank">$vers</a>);
		$ln = sprintf("%-60s  - %-16s  %-14s  %s",
					    $flnk, $dlnk, $date, $labels);
	    } else {
		$ln = sprintf("%-60s  - %-16s  %-14s  %s",
			    $path . b($base . $ext), $vers, $date, $labels);
	    }
	}

	# Strip any trailing spaces
	$ln =~ s/\s+$//;

	# Now push the modified line onto its comment's bucket.
	push(@{$Files{$name,$attrs,$cmt}}, $ln);
    }
}

# At this point we have a database (in %Files) of all changes found.
# Format and print this data, in HTML or plain text, to stdout or to mail,
# as requested.
{
    # We collect all the output and put it in an array, then print or
    # mail it later.  Done this way so we can add "wanderers" to the
    # mailing list.
    my(@Plain, @Html) = ();

    my $indent = ' 'x3;			# the amount to indent output by

    # Certain header info for the case when we're not sending mail.
    push(@Plain, "\n$indent * $title *\n\n") if $opt{plain} && !$opt{mail};
    push(@Html, html(), title($title), "<BODY BGCOLOR='#F0F0F0'><BR>\n")
							if !$opt{inhtml};
    push(@Html, font({size=>2, face=>"arial, helvetica"}) . "\n");

    # If no changes, skip to the next report and send mail only if requested
    if (! keys %Files) {
	next unless $opt{empty};
	if (! $opt{mail}) {
	    print "\n$indent(No changes)\n\n";
	    next;
	}
	my @to = split /,/, $opt{to} || $ENV{LOGNAME};
	my $smtp = Net::SMTP->new('mailhost');
	die "$prog: Net::SMTP->new failed" unless $smtp;
	$smtp->debug(1) if $ct->dbglevel > 1;
	$smtp->mail($ENV{LOGNAME}) || die "$prog: Net::SMTP failed";
	$smtp->to(@to) || die "$prog: Net::SMTP failed";
	$smtp->data() || die "$prog: Net::SMTP failed";
	$smtp->datasend(qq(To: @to\n)) || die "$prog: Net::SMTP failed";
	$smtp->datasend("Subject: [No Changes] $title\n");
	$smtp->datasend("\n") || die "$prog: Net::SMTP failed";
	$smtp->dataend() || die "$prog: Net::SMTP failed";
	$smtp->quit || die "Net::SMTP failed";
    }

    ####################################################################
    # Now we know there were changes, so it's time to generate a report.
    ####################################################################

    # Report Header information
    # can easily get into a real browser to navigate the changes.
    if ($opt{mail} && !$opt{fhref}) {
	push(@Html, "<P></P>\n");
	push(@Html, qq(Changes on ClearCase branch <I>$branch</I> ));
	push(@Html, qq(since <I>$Since</I>));
	push(@Html, qq( and before <I>$Before</I>));
	if (@ARGV > 1) {
	    push(@Html, qq( within VOB directories:\n));
	} else {
	    push(@Html, qq( within VOB directory:\n));
	}
	push(@Html, qq(<I>\n));
	for (@ARGV) {
	    push(@Html, "&nbsp;$_");
	    push(@Html, ',') unless $_ eq $ARGV[-1];
	}
	push(@Html, qq(</I>\n));
	push(@Html, qq(<P></P><HR><HR>\n));
    }

    my $prev;
    for my $key (sort keys %Files) {
	my($name, $attrs, $comment) = split(/$;/, $key);

	# One separator between each change.
	push(@Html, "\n<HR>\n") if defined($prev);

	if ($opt{fhref}) {
	    my $mailto = $opt{domain} ? "$name\@$opt{domain}" : $name;
	    $mailto =~ s%\s+%.%g;
	    $name = qq(<a href="mailto:$mailto">$name</a>);
	}

	push(@Plain, "By $name");
	push(@Html, "By " . font({color=>"blue"}, $name));

	if ($attrs) {
	    push(@Plain, " $attrs");
	    push(@Html, escapeHTML(" $attrs"));
	}
	push(@Plain, "\n");
	push(@Html, "\n");

	# Push each modified line onto the output stacks.
	for my $line (sort @{$Files{$key}}) {
	    push(@Plain, "$indent$line\n");
	    push(@Html, "<BR>\n" . $line);
	}

	# Push comment onto Html stack.
	if ($comment) {
	    push(@Html, "\n<P>\n", font({color=>'red', size=>3},
	    pre(i(escapeHTML($comment)))));
	} else {
	    push(@Html, "\n<P>\n", font({color=>'red', size=>3},
	    pre(b(escapeHTML('[No comment]')))));
	}

	# Push comment (destructively) onto Plain stack.
	$comment ||= "[No comment]\n";
	$comment =~ s/\n/\n$indent> /gs;
	push(@Plain, "\n$indent> $comment\n\n\n");

	$prev = $name;
    }

    push(@Html, qq(<HR></BODY></HTML>\n)) if !$opt{inhtml};

    # Now dump the output to either the mailer or stdout, as requested.
    if ($opt{mail}) {
	my $ttype = $opt{plain} ? 'plain' : 'html';
	my @to = split /,/, $opt{to} || $ENV{LOGNAME};
	my @body = $opt{plain} ? @Plain : @Html;
	my $smtp = Net::SMTP->new('mailhost');
	die "$prog: Net::SMTP->new failed" unless $smtp;
	$smtp->debug(1) if $ct->dbglevel > 0;
	$smtp->mail($ENV{LOGNAME}) || die "$prog: Net::SMTP failed";
	$smtp->to(@to) || die "$prog: Net::SMTP failed";
	$smtp->data() || die "$prog: Net::SMTP failed";
	$smtp->datasend("To: @to\n") || die "$prog: Net::SMTP failed";
	$smtp->datasend("Subject: $title\n");
	$smtp->datasend(qq(Content-Type: text/$ttype\n));
	$smtp->datasend("\n");
	$smtp->datasend(@body) || die "$prog: Net::SMTP failed";
	$smtp->dataend() || die "$prog: Net::SMTP failed";
	$smtp->quit || die "$prog: Net::SMTP failed";
    } else {
	print STDOUT $opt{plain} ? @Plain : @Html;
    }
}

exit 0;

__END__

=head1 NAME

CCreport - Perl script to generate a ClearCase changes report

=head1 SYNOPSIS

  # Generate a report of all changes since yesterday in /vobs/src ...
  CCreport /vobs/src

  # ... on branch 'foo'
  CCreport -branch foo /vobs/src

  # ... and send mail to tom, dick, and harry at here.com
  CCreport -branch foo -to tom,dick,harry -domain here.com /vobs/src

  # Specify a view to work through and a starting date ...
  CCreport -view admin -since 24-Mar /vobs_src

  # ... and an ending date
  CCreport -view admin -since 24-Mar -before 29-Mar /vobs_src

  # ... output plaintext instead of HTML
  CCreport -view admin -plain -since 24-Mar /vobs_src

  # Traverse multiple vob areas, show changes on any branch
  CCreport /vobs_src/proj1 /vobs/doc/proj1/html

  # Run in I<automatic> mode, driven by attributes on self
  CCreport -auto

  # Run in auto mode but issue only reports #3 and #4
  CCreport -auto -filter /[34]/

=head1 DESCRIPTION

This script traverses the specified ClearCase VOB areas and outputs a
report of changes made, formatted with their comments, version numbers,
etc. The listing can be restricted by timeslice, user(s), branch, and
so on via command-line flags (use -help for a summary).

A special I<automatic mode> is supported. When passed the C<-auto> flag
it will examine C<$0> to find attributes on itself. Attributes with
names of the form "CCrxx" where xx is an integer are considered to be
command lines to be executed in numerical order. Attributes of the form
"CCr_foo" define substitutions. For example:

    CCr1 = "-branch main -to {dev},{adm} /vobs/src /vobs/doc"
    CCr2 = "-branch bugbranch -to {qa},{adm} /vobs/src"
    CCr_adm = "tom,dick,harry"
    CCr_dev = "susan,mary"
    CCr_qa = "jeff,chris"

will generate two reports and mail them to the development and qa
groups respectively, with copies of all going to {adm}.

=head1 DEBUGGING

Run with B<-/dbg=1> (or 2) to see debug output.

=head1 AUTHOR

David Boyce <dsb@world.std.com>

=head1 COPYRIGHT

Copyright (c) 1998,1999,2000 David Boyce. All rights reserved.  This
Perl program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

perl(1), ClearCase::Argv, Argv, IPC::ClearTool

=cut
