467 lines
12 KiB
Perl
467 lines
12 KiB
Perl
###
|
|
### File:
|
|
### srcwatch.pl
|
|
###
|
|
### History:
|
|
### 06/17/2000 Jasonsch - Original hacking.
|
|
### 07/21/2000 Jasonsch - Made more general so other groups can use it.
|
|
###
|
|
### Description:
|
|
### Watches a set of directories for changes and e-mails someone about 'em.
|
|
###
|
|
|
|
use POSIX qw(strftime);
|
|
|
|
BEGIN {
|
|
require "$ENV{'SDXROOT'}\\tools\\sendmsg.pl";
|
|
}
|
|
|
|
### Constants
|
|
my $DEF_CONF_FILE = "srcwatch.txt";
|
|
my $NUM_CHANGES = 50;
|
|
|
|
### pseudo-globals
|
|
my $CDATE = localtime();
|
|
my (%config);
|
|
my $text = ""; # the body of the message
|
|
my $sendmail = 0;
|
|
|
|
if (!exists($ENV{'SDXROOT'})) {
|
|
print "srcwatch.pl must be called from a razzle window!\n";
|
|
exit(0);
|
|
}
|
|
|
|
&InitConfig(\%config, @ARGV);
|
|
$cnt = keys %{$config{'paths'}};
|
|
&InitHtmlText(\%config, $cnt);
|
|
|
|
foreach (keys %{$config{'paths'}}) {
|
|
$sendmail += &GetDepotChanges($_, \%config, $cnt);
|
|
}
|
|
|
|
$text .= << " EOHF";
|
|
</table>
|
|
</body>
|
|
</html>
|
|
EOHF
|
|
|
|
if ($sendmail) {
|
|
&sendmsg($config{'from'}, "$config{'groupname'} code changes for $config{'startdate'} to $config{'enddate'}", $text, $config{'targets'}, "content:text/html");
|
|
}
|
|
|
|
######################### S U B R O U T I N E S ##########################
|
|
|
|
sub GetTodaysDate()
|
|
{
|
|
strftime("%Y/%m/%d", localtime(time()));
|
|
}
|
|
|
|
sub GetYesterdaysDate()
|
|
{
|
|
strftime("%Y/%m/%d", localtime(time() - 60 * 60 * 24));
|
|
}
|
|
|
|
sub GetNewChanges($$$$)
|
|
{
|
|
my $sdate = shift; # start date
|
|
my $edate = shift; # end date
|
|
my $config = shift;
|
|
my $depot = shift;
|
|
my @changes = split(/\n/, `sd changes \@$sdate,$edate -s submitted`);
|
|
my ($change, $cnum, $date, $time, $who, $desc, $integration);
|
|
my (@new_changes, @files, $file, $lab, $ar);
|
|
|
|
foreach $change (@changes) {
|
|
$change =~ /^Change\s+(\d+)\s+on\s+(.*)\s+(.*)\s+by\s+(.*)\s+'(.*)'$/;
|
|
$cnum = $1; $date = $2; $time = $3; $who = $4; $desc = $5;
|
|
@files = &GetChangedFiles($cnum, $config, $depot);
|
|
next unless(@files);
|
|
|
|
# @files is an array of array refs ([$file, $lab, $op])
|
|
if ($files[0]->[2] eq 'integrate' || $files[0]->[2] eq 'branch') {
|
|
if ($files[0]->[1] eq $$config{'lab'}) {
|
|
my @md; # array of array refs (meta-data), with the structure:
|
|
# ($cnum, $date, $time, $who, $desc, @files)
|
|
@md = &GetIntegrationRecords($config, $depot, $desc, @files);
|
|
foreach $ar (@md) {
|
|
$fileref = pop(@$ar);
|
|
@files = &ExtractFiles(@$fileref);
|
|
push(@new_changes, [@$ar, $$fileref[0]->[1], [@files]]);
|
|
}
|
|
} else {
|
|
# This is just some other lab integrating files in our depots,
|
|
# which we don't care about.
|
|
next;
|
|
}
|
|
} elsif (&InOurView($files[0]->[1], $config, 0)){
|
|
my @filelist = &ExtractFiles(@files);
|
|
push(@new_changes, [$cnum, $date, $time, $who, $desc, $files[0]->[1], [@filelist]]);
|
|
}
|
|
}
|
|
|
|
@new_changes;
|
|
}
|
|
|
|
sub ExtractFiles(@)
|
|
{
|
|
my @files;
|
|
my $file;
|
|
|
|
foreach $file (@_) {
|
|
push(@files, $file->[0]);
|
|
}
|
|
|
|
@files;
|
|
}
|
|
|
|
sub GetChangedFiles($$$)
|
|
{
|
|
my $change = shift;
|
|
my $config = shift;
|
|
my $depot = shift;
|
|
my @files = split(/\n/, `sd describe -s $change`);
|
|
my (@files2, $branch, $op, $file);
|
|
|
|
foreach (@files) {
|
|
if (/^\s*\.\.\.\s+\/\/depot(\/private)?\/(\w+)\/([^\s]+) (\w+)$/) {
|
|
$branch = lc($2); $file = $3; $op = $4;
|
|
next unless (&CheckPath($file, $config, $depot));
|
|
push(@files2, [$file, $branch, $op]);
|
|
}
|
|
}
|
|
|
|
@files2;
|
|
}
|
|
|
|
sub GetIntegratedFiles($$$)
|
|
{
|
|
my $change = shift;
|
|
my $config = shift;
|
|
my $depot = shift;
|
|
my @files = split(/\n/, `sd describe -s $change`);
|
|
my (@files2, $branch, $op, $file);
|
|
|
|
foreach (@files) {
|
|
if (/^\s*\.\.\.\s+\/\/depot\/(\w+)\/([^\s]+) (\w+)$/) {
|
|
$branch = lc($1); $file = $2; $op = $3;
|
|
if (&CheckPath($file, $config, $depot)) {
|
|
### TODO: Should the test below *just* be !InOutView(...)
|
|
if (!&InOurView($branch, $config, 1) && $op ne 'integrate' && $op ne 'branch') {
|
|
push(@files2, [$file, $branch, $op]);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
@files2;
|
|
}
|
|
|
|
sub CheckIgnorePath($$$)
|
|
{
|
|
my $path = shift;
|
|
my $config = shift;
|
|
my $depot = shift;
|
|
my $ret = 0;
|
|
my $p;
|
|
|
|
foreach $p (@{$config->{'ignore_paths'}->{$depot}}) {
|
|
if ($path =~ /^$depot\/$p/i) {
|
|
$ret = 1; last;
|
|
}
|
|
}
|
|
|
|
$ret;
|
|
}
|
|
|
|
sub CheckPath($$$)
|
|
{
|
|
my $path = shift;
|
|
my $config = shift;
|
|
my $depot = shift;
|
|
my $ret = 0;
|
|
my $p;
|
|
|
|
foreach $p (@{$config->{'paths'}->{$depot}}) {
|
|
if ($path =~ /^$depot\/$p/i && !&CheckIgnorePath($path, $config, $depot)) {
|
|
$ret = 1; last;
|
|
}
|
|
}
|
|
|
|
$ret;
|
|
}
|
|
|
|
sub GetIntegrationRecords($$$)
|
|
{
|
|
my $config = shift;
|
|
my $depot = shift;
|
|
my $int_desc = shift;
|
|
my ($file, $text, @files, $cnum, $date, $time, $who, $desc, $line, @lines);
|
|
my (@changes, $shortlab);
|
|
my $originlab = "";
|
|
my %cs; # changes we've already seen
|
|
|
|
$int_desc =~ /lab(\d+)_n/i;
|
|
foreach $file (@_) {
|
|
$file->[0] =~ s/#\d+$//;
|
|
$file->[0] =~ s#^$depot/##i;
|
|
foreach $line (@lines = split(/\n/, `sd changes -i $file->[0]`)) {
|
|
chomp($line);
|
|
$line =~ /^Change\s+(\d+)\s+on\s+(.*)\s+(.*)\s+by\s+(.*)\s+'(.*)'$/;
|
|
$cnum = $1; $date = $2; $time = $3; $who = $4; $desc = $5;
|
|
last if ($who =~ /ntbuild/i && $originlab && ($desc =~ /$originlab/ || $desc =~ /$shortlab/));
|
|
next unless (@files = &GetIntegratedFiles($cnum, $config, $depot));
|
|
next if (exists($cs{$cnum}));
|
|
|
|
if (&HasFile($file->[0], @files)) {
|
|
if (!$originlab) {
|
|
$originlab = &GetOriginLab($cnum);
|
|
$originlab =~ /^lab(\d+)/i;
|
|
$shortlab = "lab$1";
|
|
}
|
|
|
|
next unless ($files[0]->[1] eq $originlab);
|
|
$cs{$cnum} = 1;
|
|
push(@changes, [$cnum, $date, $time, $who, $desc, [@files]]);
|
|
}
|
|
}
|
|
}
|
|
|
|
@changes;
|
|
}
|
|
|
|
sub GetOriginLab($)
|
|
{
|
|
my $cnum = shift;
|
|
my @lines = `sd describe -s $cnum`;
|
|
my $lab = "";
|
|
|
|
foreach (@lines) {
|
|
if (/^\s*\.\.\.\s+\/\/depot\/(\w+)\/[^\s]+\s+\w+$/) {
|
|
$lab = lc($1);
|
|
last;
|
|
}
|
|
}
|
|
|
|
lc($lab);
|
|
}
|
|
|
|
sub HasFile($@)
|
|
{
|
|
my $file = shift;
|
|
my $ret = 0;
|
|
|
|
foreach (@_) {
|
|
if ($_->[0] =~ /$file(#\d+)?$/) {
|
|
$ret = 1;
|
|
}
|
|
}
|
|
|
|
$ret;
|
|
}
|
|
|
|
sub GetDepotChanges($$)
|
|
{
|
|
my $depot = shift;
|
|
my $config = shift;
|
|
my $dc = shift;
|
|
my ($domain, $alias, $client, $who, $change, $lab);
|
|
my $bChanges = 0;
|
|
|
|
chdir("$ENV{'SDXROOT'}\\$depot");
|
|
|
|
my @changes = &GetNewChanges($$config{'startdate'}, $$config{'enddate'}, $config, $depot);
|
|
foreach $change (@changes) {
|
|
$$change[4] =~ s/</</g; $$change[4] =~ s/>/>/g;
|
|
$$change[3] =~ /^(\w+)\\(.*)\@(.*)$/;
|
|
$domain = $1; $alias = $2; $client = $3;
|
|
|
|
@files = @{$$change[6]};
|
|
$lab = $$change[5];
|
|
next if ($#files < $[);
|
|
|
|
if ($lab ne $$config{'lab'}) {
|
|
$lab = "<b>$lab</b>";
|
|
}
|
|
|
|
$bChanges = 1;
|
|
if(!exists(${$$config{'group'}}{$alias})) {
|
|
$alias = "<font color=\"#FF0000\"><b>$alias</b></font>";
|
|
}
|
|
|
|
$dh = "<td>$depot</td>" if ($dc > 1);
|
|
$text .= << " EOROW";
|
|
<tr align="center">$dh<td>$alias</td><td>$$change[0]</td><td>$$change[1]</td><td>$lab</td><td>$$change[4]</td><td>@files</td>\n
|
|
EOROW
|
|
}
|
|
|
|
$bChanges;
|
|
}
|
|
|
|
sub InitConfig($@)
|
|
{
|
|
my $config = shift;
|
|
my @args = @_;
|
|
my $configfile = $DEF_CONF_FILE;
|
|
my $startdate = "";
|
|
my $enddate = "";
|
|
my ($arg, $opt);
|
|
|
|
while (@args) {
|
|
$arg = shift(@args);
|
|
if ($arg =~ /^-(\w)/) {
|
|
$opt = $1;
|
|
if ($opt eq 'f') {
|
|
$configfile = shift(@args);
|
|
} elsif ($opt eq 's') {
|
|
$startdate = shift(@args);
|
|
} elsif ($opt eq 'e') {
|
|
$enddate = shift(@args);
|
|
} else {
|
|
&PrintUsage();
|
|
}
|
|
} else {
|
|
&PrintUsage();
|
|
}
|
|
}
|
|
|
|
if ($startdate) {
|
|
# Convert mm/dd/yy to yy/mm/dd
|
|
$startdate =~ /^(\d+)\/(\d+)\/(\d+)$/;
|
|
$startdate = "$3/$1/$2";
|
|
} else {
|
|
$startdate = &GetYesterdaysDate();
|
|
}
|
|
|
|
if ($enddate) {
|
|
# Convert mm/dd/yy to yy/mm/dd
|
|
$enddate =~ /^(\d+)\/(\d+)\/(\d+)$/;
|
|
$enddate = "$3/$1/$2";
|
|
} else {
|
|
$enddate = &GetTodaysDate();
|
|
}
|
|
|
|
$$config{'startdate'} = $startdate;
|
|
$$config{'enddate'} = $enddate;
|
|
$$config{'premonition'} = 0;
|
|
&ReadConfigFile($configfile, $config);
|
|
}
|
|
|
|
sub ReadConfigFile($$)
|
|
{
|
|
my $file = shift;
|
|
my $config = shift;
|
|
my ($key, $value, $dir, $depot);
|
|
local (*FILE);
|
|
|
|
# Fill in the config file we're reading from.
|
|
$$config{'configfile'} = $file;
|
|
|
|
if (open(FILE, $file)) {
|
|
while (<FILE>) {
|
|
/^\s*(\w+)\s*=\s*(.*)$/;
|
|
$key = $1; $value = $2;
|
|
# Some config options require fixup/processing
|
|
$key = lc($key);
|
|
if ($key eq "group") {
|
|
foreach (split(/\s+|,/, $value)) {
|
|
${$$config{'group'}}{$_} = 1;
|
|
}
|
|
} elsif ($key eq "paths") {
|
|
foreach $dir (split(/\s+|,/, $value)) {
|
|
$dir =~ /(\!)?(\w+)\\(.*)$/;
|
|
$bang = $1; $depot = $2; $dir = $3;
|
|
&PathFixup($dir);
|
|
if ($bang) {
|
|
push(@{$config->{'ignore_paths'}->{$depot}}, $dir);
|
|
} else {
|
|
push(@{$config->{'paths'}->{$depot}}, $dir);
|
|
}
|
|
}
|
|
} else {
|
|
$$config{$key} = $value;
|
|
}
|
|
}
|
|
close(FILE);
|
|
} else {
|
|
print "Couldn't open $file for reading: $!\n";
|
|
}
|
|
}
|
|
|
|
sub PrintUsage()
|
|
{
|
|
print << " EOPU";
|
|
srcwatch.pl [-f file]
|
|
-s mm/dd/yyyy - The start date of the period you want a listing for.
|
|
-e mm/dd/yyyy - The end date of the period you want a listing for.
|
|
-f file - Use file to read config info. If omitted, srcwatch.txt is assumed.
|
|
The config file looks like:
|
|
targets = jasonsch
|
|
from = jasonsch
|
|
paths = core advcore\\duser !core\\ntgdi !core\\cslpk
|
|
groupname = NTUSER
|
|
group = dwaynen gerardob hiroyama jasonsch jeffbog jstall markfi mhamid msadek
|
|
lab = lab06_dev
|
|
branches = ntuser
|
|
premonition = 1
|
|
EOPU
|
|
exit(0);
|
|
}
|
|
|
|
sub PathFixup($)
|
|
{
|
|
$_[0] =~ s#\\#/#g;
|
|
}
|
|
|
|
sub InOurView($$$)
|
|
{
|
|
my $branch = lc(shift()); # the branch the file was in
|
|
my $config = shift;
|
|
my $ip = shift; # ignore "premonition" feature
|
|
my $fRet = 0;
|
|
|
|
if (!$ip && $$config{'premonition'}) {
|
|
$fRet = 1;
|
|
} else {
|
|
if($branch ne $$config{'lab'}) {
|
|
foreach (split(/\s+/, $$config{'branches'})) {
|
|
if ($branch eq lc($_)) {
|
|
$fRet = 1;
|
|
}
|
|
}
|
|
} else {
|
|
$fRet = 1;
|
|
}
|
|
}
|
|
|
|
$fRet;
|
|
}
|
|
|
|
sub InitHtmlText($$)
|
|
{
|
|
my $config = shift;
|
|
my $dc = shift;
|
|
my $date = "";
|
|
my $dh = ""; # depot column heading, if needed
|
|
|
|
$dh = "<th>Depot</th>" if ($dc > 1);
|
|
|
|
$text .= << " EOHTML";
|
|
<html>
|
|
<head>
|
|
<title>srcwatch report</title>
|
|
<style>
|
|
<!--
|
|
p { font-family: Tahoma; font-size: 8pt }
|
|
td { font-family: Tahoma; font-size: 8pt }
|
|
th { font-family: Tahoma; font-size: 8pt; color: #FFFF00; font-weight: bold; background-color: #000080 }
|
|
table { background-color: #DEDFDE }
|
|
-->
|
|
</style>
|
|
</head>
|
|
<body bgcolor="#FFFFFF">
|
|
<table border>
|
|
<tr>$dh<th>Who</th><th>Change #</th><th>Date</th><th>Lab</th><th>Description</th><th>Files</th></tr>
|
|
EOHTML
|
|
}
|
|
__END__
|