#!/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|vcsweb: $project
vcsweb: $project
|;
} else {
print qq|vcsweb
vcsweb
|;
}
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|
| Choose project to view...
|
|;
foreach my $project (sort keys %projects) {
$q->param('project', $project);
$url = $q->self_url;
print qq|| $project |
\n|;
$bgcol = ($bgcol eq "#ffffff") ? "#ddddff" : "#ffffff";
}
print "
";
}
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|
 /$what |
|;
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 Revision $fromversion to Revision $toversion...
|;
foreach my $diffref (parse_diff($fromobj->diff($toobj))) {
print qq|| ...Line $diffref->{'oldline'}... | |;
print qq| | |;
print qq|...Line $diffref->{'newline'}... |
|;
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|| $old | |;
print qq| | |;
print qq|$new |
\n|;
} elsif ($old eq '') { # Line has been added
print qq| | |;
print qq| | |;
print qq|$new |
\n|;
} elsif ($new eq '') { # Line has been deleted
print qq|| $old | |;
print qq| | |;
print qq| |
\n|;
} else { # Line has been modified
print qq|| $old | |;
print qq| | |;
print qq|$new |
\n|;
}
}
print "";
}
print "
";
print "
";
}
# 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|
| /$what |
|;
my $obj = VCS::File->new($file);
unless (defined $obj) {
print "Not a VCS file!
";
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|
|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|
| Revision $number |
$date |
|;
print qq|| Tags: $tags |
| if $tags;
print qq|| $author | $reason |
|;
print qq|| Diff with $diffversion... |
| if $diffversion;
print qq|
|;
}
print "
";
}
sub dir {
my($q, $base, $what) = @_;
my($file, $relfile, $name, $url, $thing);
my $dir = $base . $what;
print qq|
 /$what |
|;
my $bgcol = "#ffffff";
my $d = VCS::Dir->new($dir);
unless (defined $d) {
print "
Not a VCS dir!";
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|
| $name |
\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|| $name |
\n|;
$bgcol = ($bgcol eq "#ffffff") ? "#ddddff" : "#ffffff";
}
}
print "
";
}
__END__
=head1 NAME
vcsweb - a web interface to the VCS suite
=head1 SYNOPSIS
http://hostname/location/vcsweb.cgi
=head1 DESCRIPTION
C is a demonstration of the power of the C (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-compliant module for that system.
To use, either copy or symlink C, C and
C to somewhere appropriate in the document root of a
web-server, and copy C. Modify C to taste.
=head1 SEE ALSO
L.