#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
use HTML::Template;
use CGI qw(header param);
use CGI::Carp qw(fatalsToBrowser);
use CVS::Metrics;
use CVS::Metrics::Graph;
my $extract = param('extract');
my $repository = param('repository');
my $module = param('module');
my $path = param('path');
my $tag_from = param('from_tag');
my $tag_to = param('to_tag');
my $force = param('force');
my $viewcvs = param('viewcvs');
my $cvs_root = $extract . '/' . $repository . '/' . $module;
chdir $cvs_root
or die "can't change dir $cvs_root ($!).\n";
my $cfg = '.cvs_metrics';
our ($title, $regex_tag, $start_date, $regex_ignore_tag);
if ( -r $cfg) {
warn "reading $cfg\n";
require $cfg;
}
unless (defined $regex_tag) {
$regex_tag = '\d+';
}
unless (defined $start_date) {
$start_date = '2006/01/01';
}
my $cvs = FindCvs();
my $cvs_logfile = $cvs . ' log |';
=head1 NAME
cgi_cvs_evolr - Extract from cvs log
=head1 SYNOPSIS
cgi_cvs_evolr
=head1 OPTIONS
CGI parameters
=over 8
=item cvsroot
Directory.
=item path
Sub-directory.
=item from_tag
Tag.
=item to_tag
Tag.
=back
=head1 DESCRIPTION
B<cgi_cvs_evolr> parses B<cvs log> and produces HTML reports.
These reports are between a couple of from/to tags.
Each report is composed of three parts :
- activity and energy plots
- an evolution summary : numbers of added/modified/deleted files for each directory
- an detailed report : all informations about CVS commit, sorted first by directory,
after grouped by message and sorted by date.
This tool needs File::Which, GD, Chart::Plot::Canvas, HTML::Template
and Parse::RecDescent modules.
B<cgi_cvs_evolr> is called from B<cgi_cvs_evolq> result.
=head2 Configuration file (.cvs_metrics)
If present, B<cvs_current> reads the configuration file F<.cvs_metrics>
in the current directory. The file could contains the following variables :
$title = "main";
$regex_tag = '^V\d+';
@dirs = ( "abc", "def" , "def/hij" );
$start_date = "2006/01/01";
=head1 SEE ALSO
cvs_activity, cvs_energy, cvs_tklog, cvs_wxlog
=head1 COPYRIGHT
(c) 2004-2010 Francois PERRAD, France. All rights reserved.
This library is distributed under the terms of the Artistic Licence.
=head1 AUTHOR
Francois PERRAD, francois.perrad@gadz.org
=cut
our $cvs_log = CVS::Metrics::CvsLog(
stream => $cvs_logfile,
use_cache => 1,
force => $force,
);
if ($cvs_log) {
our @tags;
my $timed = $cvs_log->getTimedTag($regex_ignore_tag);
my %matched;
while (my ($tag, $date) = each %{$timed}) {
if ($tag =~ /$regex_tag/) {
$matched{$date.$tag} = $tag;
}
}
foreach (sort keys %matched) {
push @tags, $matched{$_};
}
push @tags, 'HEAD';
$cvs_log->insertHead();
my $found = 0;
foreach (@tags) {
if ($_ eq $tag_from) {
$found = 1;
last;
}
}
GenerateError($title, "Unknown tag_from '$tag_from'.")
unless ($found);
$found = 0;
foreach (@tags) {
if ($_ eq $tag_to) {
$found = 1;
last;
}
}
GenerateError($title, "Unknown tag_to '$tag_to'.")
unless ($found);
my @tags2 = @tags;
while ($tag_from ne $tags2[0]) {
shift @tags2;
}
shift @tags2;
$found = 0;
foreach (@tags2) {
if ($_ eq $tag_to) {
$found = 1;
last;
}
}
GenerateError($title, "'$tag_from' >= '$tag_to'.")
unless ($found);
GenerateHTML($cvs_log, \@tags, $title, $path, $tag_from, $tag_to, $start_date);
}
sub FindCvs {
my $cvs;
if ($^O eq 'MSWin32') {
eval 'use File::Which';
$cvs = which('cvs');
unless (defined $cvs) {
eval 'use Win32::TieRegistry(Delimiter => "/")';
my $cvs_setting;
my $hkey = 'HKEY_CURRENT_USER/Software/WinCvs/wincvs/CVS settings';
eval '$cvs_setting = $Registry->{$hkey}';
$cvs = $cvs_setting->{'/P_WhichCvs'};
if (defined $cvs) {
$cvs =~ s/[\000\001]//g;
$cvs =~ s/wincvs\.exe\@$//;
if ( -e "${cvs}CVSNT\\\\cvs.exe") {
$cvs .= "CVSNT\\\\cvs.exe";
}
else {
$cvs .= 'cvs.exe';
}
}
}
die "cvs not found !\n" unless (defined $cvs);
warn "Using CVS : $cvs\n";
return q{"} . $cvs . q{"};
}
else {
return 'cvs';
}
}
#######################################################################
sub GenerateHTML {
my ($cvs_log, $tags, $title, $path, $tag_from, $tag_to, $start_date) = @_;
my $html = q{
<?xml version='1.0' encoding='ISO-8859-1'?>
<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Transitional//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd'>
<html xmlns='http://www.w3.org/1999/xhtml'>
<head>
<meta http-equiv='Content-Type' content='text/html; charset=ISO-8859-1' />
<meta name='generator' content='<TMPL_VAR NAME=generator>' />
<meta name='date' content='<TMPL_VAR NAME=date>' />
<meta name='robots' content='nofollow' />
<title>cvs_evol <!-- TMPL_VAR NAME=title --></title>
<style type='text/css'>
<!-- TMPL_VAR NAME=style -->
</style>
</head>
<body>
<h1>Evolution Report</h1>
<h1><!-- TMPL_VAR NAME=title --></h1>
<hr />
<h2>Activity</h2>
<img src='<TMPL_VAR NAME=a_img>' />
<h2>Context</h2>
<table class='layout'>
<tr>
<td valign='top'><img src='<TMPL_VAR NAME=e_img>' /></td>
<td valign='top'>
<table border='1' cellpadding='5'>
<tr>
<th>Tag</th>
<th>Date</th>
</tr>
<!-- TMPL_LOOP NAME=timed_tag -->
<tr>
<td><!-- TMPL_VAR NAME=tag --></td>
<td><!-- TMPL_VAR NAME=timed --></td>
</tr>
<!-- /TMPL_LOOP -->
</table>
</td>
</tr>
</table>
<hr />
<h2>Evolution Report Summary</h2>
<table border='1' cellpadding='5'>
<tr>
<th width='40%'>Directories</th>
<th width='20%'>Added files</th>
<th width='20%'>Modified files</th>
<th width='20%'>Deleted files</th>
</tr>
<!-- TMPL_LOOP NAME=summary -->
<tr>
<td><a href='#<TMPL_VAR NAME=dir>'><!-- TMPL_VAR NAME=dir --></a></td>
<td><!-- TMPL_VAR NAME=added --></td>
<td><!-- TMPL_VAR NAME=modified --></td>
<td><!-- TMPL_VAR NAME=deleted --></td>
</tr>
<!-- /TMPL_LOOP -->
<tr class='total'>
<td>TOTAL</td>
<td><!-- TMPL_VAR NAME=total_added --></td>
<td><!-- TMPL_VAR NAME=total_modified --></td>
<td><!-- TMPL_VAR NAME=total_deleted --></td>
</tr>
</table>
<hr />
<h2>Detailed Evolution Report</h2>
<table width='100%' border='1' cellpadding='5'>
<tr>
<th width='20%'>Directories</th>
<th width='40%'>Messages</th>
<th width='30%'>File Descriptions</th>
<th width='10%'>Actions</th>
</tr>
<!-- TMPL_LOOP NAME=dirs --><tr>
<td valign='top' rowspan='<TMPL_VAR NAME=rowspan>'><a id='<TMPL_VAR NAME=dir>'
name='<TMPL_VAR NAME=dir>' /><!-- TMPL_VAR NAME=dir --></td>
<!-- TMPL_LOOP NAME=comments -->
<!-- TMPL_UNLESS NAME=__FIRST__ --><tr><!-- /TMPL_UNLESS -->
<td valign='top' rowspan='<TMPL_VAR NAME=rowspan>'><!-- TMPL_VAR NAME=comment --></td>
<!-- TMPL_LOOP NAME=files -->
<!-- TMPL_UNLESS NAME=__FIRST__ --><tr><!-- /TMPL_UNLESS -->
<td><span class='filename'><!-- TMPL_VAR NAME=filename --></span>
<span class='revision'><!-- TMPL_VAR NAME=revision --></span><br />
<!-- TMPL_LOOP NAME=tags -->
<span class='tag'><!-- TMPL_VAR NAME=tag --></span><br />
<!-- /TMPL_LOOP -->
<span class='author'><!-- TMPL_VAR NAME=author --></span>
<span class='date'><!-- TMPL_VAR NAME=date --></span></td>
<td><!-- TMPL_VAR NAME=action --></td>
</tr><!-- /TMPL_LOOP -->
<!-- /TMPL_LOOP -->
<!-- /TMPL_LOOP -->
</table>
<hr />
<cite>Generated by cgi_cvs_evolr (<!-- TMPL_VAR NAME=date -->)</cite>
</body>
</html>
};
my $style = q{
body { background-color: #CCFFFF }
table { background-color: #FFFFFF }
th { background-color: #CCCCCC }
h1 { text-align: center }
h2 { color: red }
td a { font-weight: bold }
tr.total { font-weight: bold }
table.layout { background-color: #CCFFFF }
span.author { font-weight: bold }
span.filename { color: blue }
a.filename { font-weight: normal }
span.revision { font-weight: bold; color: blue }
span.tag { font-weight: bold }
span.date { }
span.deleted { font-weight: bold; color: red }
span.added { font-weight: bold; color: blue }
span.modified { font-weight: bold }
a.modified { font-weight: bold }
};
$html =~ s/^\s+//gm;
my $template = HTML::Template->new(
loop_context_vars => 1,
scalarref => \$html,
);
die "can't create template ($!).\n"
unless (defined $template);
my $now = localtime();
my $generator = 'cgi_cvs_evolr ' . $CVS::Metrics::VERSION . ' (Perl ' . $] . ')';
my $dir = $path eq '.' ? 'all' : $path;
my $title_full = "${title} ${dir} ${tag_from} to ${tag_to}";
my $base = $cvs_root . '/';
$base =~ s/^$ENV{DOCUMENT_ROOT}//;
my $image = $cvs_log->EnergyGD($tags, $path, $dir, 600, 400, $tag_from, $tag_to);
my $e_img = "e_${title_full}.png";
$e_img =~ s/[ \/]/_/g;
if (defined $image) {
open my $OUT, '>', $e_img
or die "can't open $e_img ($!).\n";
binmode $OUT, ':raw';
print $OUT $image->png();
close $OUT;
}
my $timed_tag = $cvs_log->getTimedTag($regex_ignore_tag);
my @timed_tag = ();
foreach my $tag (@{$tags}) {
if ($tag eq 'HEAD') {
push @timed_tag, {
tag => $tag,
timed => 'now',
};
}
else {
push @timed_tag, {
tag => $tag,
timed => substr($timed_tag->{$tag}, 0, 10),
};
}
}
my $date_from = substr($timed_tag->{$tag_from}, 0, 10);
my $date_to = substr($timed_tag->{$tag_to}, 0, 10);
$image = $cvs_log->ActivityGD($path, $dir, $start_date, 800, 225, $date_from, $date_to);
my $a_img = "a_${title_full}.png";
$a_img =~ s/[ \/]/_/g;
if (defined $image) {
open my $OUT, '>', $a_img
or die "can't open $a_img ($!).\n";
binmode $OUT, ':raw';
print $OUT $image->png();
close $OUT;
}
my $dir_evol = $cvs_log->getDirEvolution($path, $tag_from, $tag_to, $tags);
my @summary = ();
my $total_added = 0;
my $total_modified = 0;
my $total_deleted = 0;
foreach my $dirname (sort keys %{$dir_evol}) {
my @val = @{$dir_evol->{$dirname}};
next unless ($val[0] or $val[1] or $val[2]);
push @summary, {
dir => $dirname,
added => $val[0],
modified => $val[1],
deleted => $val[2],
};
$total_added += $val[0];
$total_modified += $val[1];
$total_deleted += $val[2];
}
my $evol = $cvs_log->getEvolution($path, $tag_from, $tag_to, $tags);
my @dirs = ();
foreach my $dirname (sort keys %{$evol}) {
my $dir = $evol->{$dirname};
my %date_sorted;
next unless (scalar keys %{$dir});
my $i = 0;
foreach my $message (keys %{$dir}) {
my $files = $dir->{$message};
my $file0 = $files->[0];
$date_sorted{$file0->{date} . "#$i"} = $message;
$i ++;
}
my $rowspan1 = 0;
my @comments = ();
foreach (sort keys %date_sorted) {
my $message = $date_sorted{$_};
my $files = $dir->{$message};
my $rowspan2 = 0;
my @files = ();
foreach my $file (@{$files}) {
my @tags = ();
foreach my $tag (sort @{$file->{tags}}) {
push @tags, {
tag => $tag,
};
}
my $action;
if ($file->{state} eq 'dead') {
$action = "<span class='deleted'>DELETED</span>";
}
else {
if ($file->{revision} =~ /^1\.1(\.\d+\.1)?$/) {
$action = "<span class='added'>ADDED</span>";
}
else {
my $r1 = $file->{revision};
$r1 =~ s/(\d+)$/$1-1/e;
$r1 =~ s/\.\d+\.0//;
my $r2 = $file->{revision};
$action = "<a class='modified' href='" . $viewcvs . $module . $file->{filename} . ".diff?r1=" . $r1 . "\&r2=" . $r2 . "\&root=cvs:" . $repository . "'>MODIFIED</a>";
}
}
my $filename;
if ($file->{state} eq 'dead') {
$filename = basename($file->{filename});
}
else {
$filename = "<a class='filename' href='" . $viewcvs . $module . $file->{filename} . "?rev=" . $file->{revision} . "\&content-type=text\%2Fplain\&root=cvs:" . $repository . "'>" . basename($file->{filename}) . "</a>";
}
push @files, {
filename => $filename,
revision => $file->{revision},
date => $file->{date},
author => $file->{author},
action => $action,
tags => \@tags,
};
$rowspan1 ++;
$rowspan2 ++;
}
$message =~ s/&/&/g;
$message =~ s/</</g;
$message =~ s/>/>/g;
$message =~ s/\n/<br \/>/g;
push @comments, {
rowspan => $rowspan2,
comment => $message,
files => \@files,
};
}
push @dirs, {
rowspan => $rowspan1,
dir => $dirname,
comments => \@comments,
}
}
$template->param(
style => $style,
generator => $generator,
date => $now,
title => $title_full,
e_img => $base . $e_img,
a_img => $base . $a_img,
timed_tag => \@timed_tag,
summary => \@summary,
total_added => $total_added,
total_modified => $total_modified,
total_deleted => $total_deleted,
dirs => \@dirs,
);
print header(
-type => 'text/html',
);
print $template->output();
}
sub GenerateError {
my ($title, $message) = @_;
my $error = q{
<?xml version='1.0' encoding='ISO-8859-1'?>
<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Transitional//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd'>
<html xmlns='http://www.w3.org/1999/xhtml'>
<head>
<meta http-equiv='Content-Type' content='text/html; charset=ISO-8859-1' />
<meta name='generator' content='<TMPL_VAR NAME=generator>' />
<meta name='date' content='<TMPL_VAR NAME=date>' />
<title>cvs_evol <!-- TMPL_VAR NAME=title --></title>
<style type='text/css'>
<!-- TMPL_VAR NAME=style -->
</style>
</head>
<body>
<h1><!-- TMPL_VAR NAME=title --></h1>
<hr />
<h2>Error</h2>
<blockquote><em><!-- TMPL_VAR NAME=message --></em></blockquote>
<hr />
<cite>Generated by cgi_cvs_evolr (<!-- TMPL_VAR NAME=date -->)</cite>
</body>
</html>
};
my $style = q{
body { background-color: #CCFFFF }
h1 { text-align: center }
h2 { color: red }
};
$error =~ s/^\s+//gm;
my $template = HTML::Template->new(
scalarref => \$error,
);
die "can't create template ($!).\n"
unless (defined $template);
my $now = localtime();
my $generator = 'cgi_cvs_evolr ' . $CVS::Metrics::VERSION . ' (Perl ' . $] . ')';
$template->param(
style => $style,
generator => $generator,
date => $now,
title => $title,
message => $message,
);
print header(
-type => 'text/html',
);
print $template->output();
exit;
}