===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 3.1
retrieving revision 3.4
diff -u -p -r3.1 -r3.4
--- cvsweb/cvsweb.cgi 2000/07/19 21:59:47 3.1
+++ cvsweb/cvsweb.cgi 2000/07/28 17:24:35 3.4
@@ -41,7 +41,7 @@
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
-# $Id: cvsweb.cgi,v 3.1 2000/07/19 21:59:47 knu Exp $
+# $Id: cvsweb.cgi,v 3.4 2000/07/28 17:24:35 knu Exp $
#
###
@@ -55,8 +55,9 @@ use vars qw (
@revisions %state %difflines %log %branchpoint @revorder $prcgi
@prcategories $prcategories
$checkoutMagic $doCheckout $scriptname $scriptwhere
- $where $Browser $nofilelinks $maycompress @stickyvars
- %functionlineregexp
+ $where $pathinfo $Browser $nofilelinks $maycompress @stickyvars
+ %funcline_regexp $is_mod_perl
+ $is_lynx $is_msie $is_mozilla3
%input $query $barequery $sortby $bydate $byrev $byauthor
$bylog $byfile $hr_default $logsort $cvstree $cvsroot
$mimetype $defaultTextPlain $defaultViewable $allow_compress
@@ -64,7 +65,7 @@ use vars qw (
$cvstreedefault $body_tag $logo $defaulttitle $address
$backcolor $long_intro $short_instruction $shortLogLen
$show_author $dirtable $tablepadding $columnHeaderColorDefault
- $columnHeaderColorSorted $hr_breakable $hr_funout $hr_ignwhite
+ $columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite
$hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove
$diffcolorChange $diffcolorAdd $diffcolorDarkChange $difffontface
$difffontsize $inputTextSize $mime_types $allow_annotate
@@ -80,7 +81,7 @@ use vars qw (
##### Start of Configuration Area ########
# == EDIT this ==
# User configuration is stored in
-$config = $ENV{'CVSWEB_CONFIG'} || '/usr/local/etc/cvsweb.conf';
+$config = defined($ENV{CVSWEB_CONFIG}) ? $ENV{CVSWEB_CONFIG} : '/usr/local/etc/cvsweb.conf';
# == Configuration defaults ==
# Defaults for configuration variables that shouldn't need
@@ -96,7 +97,7 @@ $allow_version_select = 1;
$cvstreedefault = $body_tag = $logo = $defaulttitle = $address =
$backcolor = $long_intro = $short_instruction = $shortLogLen =
$show_author = $dirtable = $tablepadding = $columnHeaderColorDefault =
-$columnHeaderColorSorted = $hr_breakable = $hr_funout = $hr_ignwhite =
+$columnHeaderColorSorted = $hr_breakable = $showfunc = $hr_ignwhite =
$hr_ignkeysubst = $diffcolorHeading = $diffcolorEmpty = $diffcolorRemove =
$diffcolorChange = $diffcolorAdd = $diffcolorDarkChange = $difffontface =
$difffontsize = $inputTextSize = $mime_types = $allow_annotate =
@@ -113,26 +114,31 @@ use IPC::Open2;
$verbose = $v;
$checkoutMagic = "~checkout~";
-$where = defined($ENV{'PATH_INFO'}) ? $ENV{'PATH_INFO'} : "";
+$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';
+$where = $pathinfo;
$doCheckout = ($where =~ /^\/$checkoutMagic/);
$where =~ s|^/($checkoutMagic)?||;
$where =~ s|/+$||;
-($scriptname = $ENV{'SCRIPT_NAME'}) =~ s|^/?|/|;
+$scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';
+$scriptname =~ s|^/?|/|;
$scriptname =~ s|/+$||;
+$scriptwhere = $scriptname;
if ($where) {
- $scriptwhere = $scriptname . '/' . urlencode($where);
+ $scriptwhere .= '/' . urlencode($where);
}
-else {
- $scriptwhere = $scriptname;
-}
-$scriptwhere =~ s|/+$||;
+$is_mod_perl = defined($ENV{MOD_PERL});
+
# in lynx, it it very annoying to have two links
# per file, so disable the link at the icon
# in this case:
-$Browser = $ENV{'HTTP_USER_AGENT'};
-$nofilelinks = ($Browser =~ m'^Lynx/');
+$Browser = $ENV{HTTP_USER_AGENT} || '';
+$is_lynx = ($Browser =~ m`^Lynx/`);
+$is_msie = ($Browser =~ m`MSIE`);
+$is_mozilla3 = ($Browser =~ m`^Mozilla/[3456789]`);
+$nofilelinks = $is_lynx;
+
# newer browsers accept gzip content encoding
# and state this in a header
# (netscape did always but didn't state it)
@@ -143,19 +149,19 @@ $nofilelinks = ($Browser =~ m'^Lynx/');
# Turn off gzip if running under mod_perl. piping does
# not work as expected inside the server. One can probably
# achieve the same result using Apache::GZIPFilter.
-$maycompress =(($ENV{'HTTP_ACCEPT_ENCODING'} =~ m|gzip|
- || $Browser =~ m%^Mozilla/3%)
- && ($Browser !~ m/MSIE/)
- && !defined($ENV{'MOD_PERL'}));
+$maycompress =(($ENV{HTTP_ACCEPT_ENCODING} =~ m`gzip`
+ || $is_mozilla3)
+ && !$is_msie
+ && !$is_mod_perl);
# put here the variables we need in order
# to hold our state - they will be added (with
# their current value) to any link/query string
# you construct
-@stickyvars = ('cvsroot','hideattic','sortby','logsort','f','only_with_tag');
+@stickyvars = qw(cvsroot hideattic sortby logsort fonly_with_tag);
if (-f $config) {
- do "$config";
+ do $config;
}
else {
&fatal("500 Internal Error",
@@ -166,7 +172,9 @@ else {
}
undef %input;
-if ($query = $ENV{'QUERY_STRING'}) {
+$query = $ENV{QUERY_STRING};
+
+if ($query ne '') {
foreach (split(/&/, $query)) {
s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted
if (/(\S+)=(.*)/) {
@@ -209,8 +217,9 @@ foreach (keys %DEFAULTVALUE)
$barequery = "";
foreach (@stickyvars) {
# construct a query string with the sticky non default parameters set
- if (defined($input{$_}) && $input{$_} ne "" && $input{$_} ne $DEFAULTVALUE{$_}) {
- if ($barequery) {
+ if (defined($input{$_}) && $input{$_} ne '' &&
+ !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_})) {
+ if ($barequery) {
$barequery = $barequery . "&";
}
my $thisval = urlencode($_) . "=" . urlencode($input{$_});
@@ -251,7 +260,7 @@ else {
$hr_default = $input{'f'} eq 'h';
-$logsort = $input{"logsort"};
+$logsort = $input{'logsort'};
## Default CVS-Tree
@@ -276,10 +285,10 @@ foreach my $k (keys %ICONS) {
no strict 'refs';
my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}};
if ($ipath) {
- $ {"${k}icon"} = "";
+ ${"${k}icon"} = "
";
}
else {
- $ {"${k}icon"} = $itxt;
+ ${"${k}icon"} = $itxt;
}
}
@@ -312,7 +321,6 @@ if (-d $fullname) {
# ensure, that directories always end with (exactly) one '/'
# to allow relative URL's. If they're not, make a redirect.
##
- my $pathinfo = defined($ENV{'PATH_INFO'}) ? $ENV{'PATH_INFO'} : "";
if (!($pathinfo =~ m|/$|) || ($pathinfo =~ m |/{2,}$|)) {
redirect ($scriptwhere . '/' . $query);
}
@@ -347,11 +355,12 @@ elsif (-d $fullname) {
getDirLogs($cvsroot,$where,@subLevelFiles);
if ($where eq '/') {
- html_header("$defaulttitle");
+ html_header($defaulttitle);
+ $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g;
print $long_intro;
}
else {
- html_header("$where");
+ html_header($where);
print $short_instruction;
}
@@ -906,11 +915,11 @@ sub revcmp {
sub fatal {
my($errcode, $errmsg) = @_;
- if (defined($ENV{'MOD_PERL'})) {
+ if ($is_mod_perl) {
Apache->request->status((split(/ /, $errcode))[0]);
}
else {
- print "Status: $errcode\n";
+ print "Status: $errcode\r\n";
}
html_header("Error");
print "Error: $errmsg\n";
@@ -920,13 +929,13 @@ sub fatal {
sub redirect {
my($url) = @_;
- if (defined($ENV{'MOD_PERL'})) {
+ if ($is_mod_perl) {
Apache->request->status(301);
Apache->request->header_out(Location => $url);
}
else {
- print "Status: 301 Moved\n";
- print "Location: $url\n";
+ print "Status: 301 Moved\r\n";
+ print "Location: $url\r\n";
}
html_header("Moved");
print "This document is located here.\n";
@@ -1006,7 +1015,7 @@ sub doAnnotate ($$) {
# reasons ..
if (!($rev =~ /^[\d\.]+$/)) {
&fatal("404 Not Found",
- "Malformed query \"$ENV{'QUERY_STRING'}\"");
+ "Malformed query \"$ENV{QUERY_STRING}\"");
}
($pathname = $where) =~ s/(Attic\/)?[^\/]*$//;
@@ -1052,7 +1061,7 @@ sub doAnnotate ($$) {
# least to the point of including the directories down to the one
# containing the file in question).
# So if $where is "dir/sdir/file", then @dirs will be ("dir","sdir","file")
- my @dirs = split (/\//, $where);
+ my @dirs = split('/', $where);
my $path = "";
foreach (@dirs) {
if ($path eq "") {
@@ -1060,12 +1069,12 @@ sub doAnnotate ($$) {
$path = $_;
}
else {
- print $writer "Directory " . $path . "\n";
- print $writer "$cvsroot/" . $path ."\n";
+ print $writer "Directory $path\n";
+ print $writer "$cvsroot/$path\n";
# In our example, $_ is "sdir" and $path becomes "dir/sdir"
# And the next time, "file" and "dir/sdir/file" (which then gets
# ignored, because we don't need to send Directory for the file).
- $path = $path . "/" . $_;
+ $path .= "/$_";
}
}
# And the last "Directory" before "annotate" is the top level.
@@ -1122,7 +1131,7 @@ sub doAnnotate ($$) {
$oldLusr = $lusr;
# is there a less timeconsuming way to strip spaces ?
($lrev = $lrev) =~ s/\s+//g;
- my $isCurrentRev = ("$rev" eq "$lrev");
+ my $isCurrentRev = ($rev eq $lrev);
print "" if ($isCurrentRev);
printf ("%8s%s%8s %4d:", $revprint, ($isCurrentRev ? "|" : " "), $usrprint, $lineNr);
@@ -1159,7 +1168,7 @@ sub doCheckout {
# reasons ..
if (defined($rev) && !($rev =~ /^[\d\.]+$/)) {
&fatal("404 Not Found",
- "Malformed query \"$ENV{'QUERY_STRING'}\"");
+ "Malformed query \"$ENV{QUERY_STRING}\"");
}
# get mimetype
@@ -1193,7 +1202,7 @@ sub doCheckout {
# Safely for a child process to read from.
if (! open($fh, "-|")) { # child
open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
- exec("cvs", "-d", "$cvsroot", "co", "-p", "$revopt", "$where");
+ exec("cvs", "-d", $cvsroot, "co", "-p", $revopt, $where);
}
#===================================================================
#Checking out squid/src/ftp.c
@@ -1316,7 +1325,7 @@ sub doDiff {
# reasons ..
if (!($rev1 =~ /^[\d\.]+$/) || !($rev2 =~ /^[\d\.]+$/)) {
&fatal("404 Not Found",
- "Malformed query \"$ENV{'QUERY_STRING'}\"");
+ "Malformed query \"$ENV{QUERY_STRING}\"");
}
#
# rev1 and rev2 are now both numeric revisions.
@@ -1355,19 +1364,19 @@ sub doDiff {
}
# apply special options
- if ($human_readable) {
- if ($hr_funout) {
- push @difftype, '-p';
+ if ($showfunc) {
+ push @difftype, '-p';
- my($re1, $re2);
+ my($re1, $re2);
- while (($re1, $re2) = each %functionlineregexp) {
- if ($fullname =~ /$re1/) {
- push @difftype, '-F', '$re2';
- last;
- }
+ while (($re1, $re2) = each %funcline_regexp) {
+ if ($fullname =~ /$re1/) {
+ push @difftype, '-F', '$re2';
+ last;
}
}
+ }
+ if ($human_readable) {
if ($hr_ignwhite) {
push @difftype, '-w';
}
@@ -1376,8 +1385,8 @@ sub doDiff {
}
}
if (! open($fh, "-|")) { # child
- open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
- exec("rcsdiff",@difftype,"-r$rev1","-r$rev2",$fullname);
+ open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
+ exec("rcsdiff",@difftype,"-r$rev1","-r$rev2",$fullname);
}
if ($human_readable) {
http_header();
@@ -1467,7 +1476,7 @@ sub getDirLogs {
else {
my $kidpid = open($fh, "-|");
if (! $kidpid) {
- close(STDERR); # rlog may complain; ignore.
+ open(STDERR, '>/dev/null'); # rlog may complain; ignore.
exec("rlog","-r",@files);
}
}
@@ -2018,11 +2027,12 @@ sub doLog {
$backurl = $scriptname . "/" . urlencode($upwhere) . $query;
print &link($backicon, "$backurl#$filename"),
" Up to ", &clickablePath($upwhere, 1), "
\n"; - print "Request diff between arbitrary revisions\n"; - print "