#!/usr/bin/perl -w
# vcsweb - a sample utility program to show off the power of
# VCS::
# Do not edit this file, rather edit vcsweb.ini instead!
sub BEGIN {
# Read the configuration file
my $configfile = 'vcsweb.ini';
unless (my $return = do $configfile) {
die "Couldn't parse $configfile: $@" if $@;
die "Couldn't do $configfile: $!" unless defined $return;
die "Couldn't run $configfile" unless $return;
}
}
use strict;
no strict 'vars';
use CGI;
use CGI::Carp 'fatalsToBrowser';
use VCS;
$| = 1;
my $q = new CGI;
my $what = $q->param('what') || "";
if ($what =~ /\.\./) {
print "Nice try.";
exit 0;
}
my $base;
my $project = $q->param('project');
$base = $projects{$project} if (defined $project);
$base .= '/' if (defined $base && $base !~ m|/$|);
print $q->header;
if (defined $base) {
print qq|<head><title>vcsweb: $project</title></head>
<body bgcolor="#ffffff"><h3>vcsweb: $project</h3>|;
} else {
print qq|<head><title>vcsweb</title></head>
<body bgcolor="#ffffff"><h3>vcsweb</h3>|;
}
if (not defined $base) {
choose_project($q);
} elsif (defined $q->param('show')) {
show($q, $base, $what);
} elsif (defined $q->param('diff')) {
diff($q, $base, $what);
} else {
dir($q, $base, $what);
}
sub choose_project {
my $q = shift;
my $url;
my $bgcol = '#ffffff';
print qq|
<hr noshade><table cellpadding=8 cellspacing=0>
<tr><td bgcolor="#000000"><b><font color="#ffffff">Choose project to view...</font></b>
</td></tr>|;
foreach my $project (sort keys %projects) {
$q->param('project', $project);
$url = $q->self_url;
print qq|<tr><td bgcolor="$bgcol"><a href="$url">$project</a></td></tr>\n|;
$bgcol = ($bgcol eq "#ffffff") ? "#ddddff" : "#ffffff";
}
print "</table></ul><p><hr noshade>";
}
sub html_encode {
my $line = shift;
$line =~ s|&|&|g;
$line =~ s|\>|>|g;
$line =~ s|\<|<|g;
$line =~ s| |\ |g;
$line;
}
sub diff {
my($q, $base, $what) = @_;
my $file = $base . $what;
print qq|<hr noshade>
<table cellspacing=0 border=0 width=100% cellpadding=5>
<tr><td bgcolor="#000000"><img src="file.gif"> <b><font color="#ffffff">/$what</font></b><p></td></tr>
</table>
<ul>
|;
my $fromversion = $q->param('from');
my $toversion = $q->param('to');
my $fromobj = VCS::Version->new($file, $fromversion);
my $toobj = VCS::Version->new($file, $toversion);
print qq|Differences from <b>Revision $fromversion</b> to <b>Revision $toversion</b>...<p>
<table border=0 cellspacing=0 cellpadding=1>|;
foreach my $diffref (parse_diff($fromobj->diff($toobj))) {
print qq|<tr><td align=center bgcolor="#ccccff">...Line $diffref->{'oldline'}...</td>|;
print qq|<td bgcolor="#ffffff"> </td>|;
print qq|<td align=center bgcolor="#ccccff">...Line $diffref->{'newline'}...</td></tr>|;
foreach my $difflineref (@{$diffref->{'difflines'}}) {
my $old = html_encode($difflineref->{'old'});
my $new = html_encode($difflineref->{'new'});
if ($old eq $new) { # Line has not changed
print qq|<tr><td><tt><small>$old</small></tt></td>|;
print qq|<td bgcolor="#ffffff"> </td>|;
print qq|<td><tt><small>$new</small></tt></td></tr>\n|;
} elsif ($old eq '') { # Line has been added
print qq|<tr><td></td>|;
print qq|<td bgcolor="#ffffff"> </td>|;
print qq|<td bgcolor="#ccffcc"><tt><small>$new</small></tt></td></tr>\n|;
} elsif ($new eq '') { # Line has been deleted
print qq|<tr><td bgcolor="#ffcccc"><tt><small>$old</small></tt></td>|;
print qq|<td bgcolor="#ffffff"> </td>|;
print qq|<td> </td></tr>\n|;
} else { # Line has been modified
print qq|<tr><td bgcolor="#ffffbb"><tt><small>$old</small></tt></td>|;
print qq|<td bgcolor="#ffffff"> </td>|;
print qq|<td bgcolor="#ffffbb"><tt><small>$new</small></tt></td></tr>\n|;
}
}
print "<p>";
}
print "</table></ul>";
print "<p><hr><p>";
}
# parse_diff takes a unified diff and returns a list of \%diff
# %diff holds oldline=>num, newline=>num, difflines=>\list of \%difflines
# %difflines holds old=>text, new=>text
# It still needs the "flush" subroutine, just below
#
# And example structure follows, with one changed line (1), one empty
# line which has not changed (2), one added line (3), and one deleted
# line (15)
#
# (
# {
# 'oldline' => 1,
# 'newline' => 1,
# 'difflines' => (
# {
# 'old' => '# This is version 1.12',
# 'new' => '# This is version 1.13'
# },
# {
# 'old' => '',
# 'new' => ''
# },
# {
# 'old' => '',
# 'new' => 'use DBI;'
# }
# )
# },
# {
# 'oldline' => 15,
# 'newline' => 16,
# 'difflines' => (
# {
# 'old' => 'use strict;',
# 'new' => ''
# },
# )
# }
# )
sub parse_diff {
my $diff_text = shift;
my(@left, @right);
my @difflist; # this holds a list of \%diff
my $state = "dump";
my @difflines;
foreach my $line (split "\n", $diff_text) {
my ($oldline,$newline) = $line =~ /@@ \-(\d+).*\+(\d+).*@@/;
if ($oldline) {
if (@difflist) {
$difflist[-1]->{'difflines'} = [ @difflines ];
@difflines = ();
}
push @difflist, {
oldline => $oldline,
newline => $newline,
difflines => \@difflines,
};
} elsif ($line =~ s|^\+||) {
if ($state eq "dump") {
push @difflines, { old => '', new => $line };
} else {
$state = "PreChange";
push @right, $line;
}
} elsif ($line =~ s|^-||) {
$state = "PreChangeRemove";
push @left, $line;
} elsif ($line =~ m|^\\|) {
} else {
if ($state eq "PreChangeRemove") {
push @difflines, map { { old => $_, new => '' } } @left;
} elsif ($state eq "PreChange") {
for (my $j = 0; $j < @left || $j < @right ; $j++) {
push @difflines, {
old => ($j < @left ? $left[$j] : ''),
new => ($j < @right ? $right[$j] : ''),
};
}
}
@left = ();
@right = ();
$state = "dump";
$line =~ s|^.||;
push @difflines, { old => $line, new => $line };
}
}
if (@difflist) {
my @newdifflines = @difflines;
$difflist[-1]->{'difflines'} = \@newdifflines;
}
@difflist;
}
sub show {
my($q, $base, $what) = @_;
$q->delete('show');
my $file = $base . $what;
print qq|<hr noshade>
<table cellspacing=0 border=0 width=100% cellpadding=5>
<tr><td bgcolor="#000000"><img src="file.gif"> <b><font color="#ffffff">/$what</font></b><p></td></tr>
</table>
<ul>
|;
my $obj = VCS::File->new($file);
unless (defined $obj) {
print "Not a VCS file!</ul>";
return;
}
my($version, $number, $author, $tags, $date, $reason, $diffversion, $url);
my @versions = reverse $obj->versions;
my @diffversions = @versions;
shift @diffversions;
foreach $version (@versions) {
$number = $version->version;
$author = $version->author;
$tags = join ", ", sort $version->tags;
$date = $version->date;
$reason = html_encode($version->reason);
$reason =~ s|\n|<br>|g;
$diffversion = (@diffversions) ? (shift @diffversions)->version : "";
$q->param('to', $number);
$q->param('from', $diffversion);
$q->param('what', $what);
$q->param('diff', 1);
$url = $q->self_url;
print qq|
<table width="70%" bgcolor="#ddddff" cellspacing=0 cellpadding=5 border=0>
<tr>
<td><b>Revision $number</b></td>
<td align=right width="80%"><small>$date</small></td>
</tr>|;
print qq|<tr><td colspan=2>Tags: $tags</td></tr>| if $tags;
print qq|<tr><td valign=top><i>$author</i></td><td>$reason</td></tr>|;
print qq|<tr><td colspan=2><a href="$url">Diff with $diffversion...</a></td></tr>| if $diffversion;
print qq|</table><p>|;
}
print "</ul><hr noshade>";
}
sub dir {
my($q, $base, $what) = @_;
my($file, $relfile, $name, $url, $thing);
my $dir = $base . $what;
print qq|<hr noshade>
<table cellspacing=0 border=0 width=100% cellpadding=5>
<tr><td bgcolor="#000000"><img src="folder.gif"> <b><font color="#ffffff">/$what</font></b><p></td></tr>
|;
my $bgcol = "#ffffff";
my $d = VCS::Dir->new($dir);
unless (defined $d) {
print "</table><p>Not a VCS dir!</ul>";
return;
}
foreach $thing ($d->content) {
next unless ref($thing);
$file = $thing->path;
($name = $file) =~ s|$dir||;
($relfile = $file) =~ s|$base||;
if (ref($thing) =~ /::Dir$/) {
$q->param('what', "$relfile");
$url = $q->self_url;
print qq|<tr><td bgcolor="$bgcol"><img src="folder.gif"> <a href="$url">$name</a></td></tr>\n|;
$bgcol = ($bgcol eq "#ffffff") ? "#ddddff" : "#ffffff";
} elsif (ref($thing) =~ /::File$/) {
$q->param('what', "$relfile");
$q->param('show', 1);
$url = $q->self_url;
$q->delete('show');
print qq|<tr><td bgcolor="$bgcol"><img src="file.gif"> <a href="$url">$name</a></td></tr>\n|;
$bgcol = ($bgcol eq "#ffffff") ? "#ddddff" : "#ffffff";
}
}
print "</table><hr noshade>";
}
__END__
=head1 NAME
vcsweb - a web interface to the VCS suite
=head1 SYNOPSIS
http://hostname/location/vcsweb.cgi
=head1 DESCRIPTION
C<vcsweb> is a demonstration of the power of the C<VCS> (Version
Control System) suite, providing a web interface to projects under
version control. A project under any VCS can be viewed, provided there
is a C<VCS>-compliant module for that system.
To use, either copy or symlink C<vcsweb.cgi>, C<folder.gif> and
C<file.gif> to somewhere appropriate in the document root of a
web-server, and copy C<vcsweb.ini>. Modify C<vcsweb.ini> to taste.
=head1 SEE ALSO
L<VCS>.