version 3.26, 2000/09/22 11:13:17 |
version 3.31, 2000/10/02 19:07:08 |
Line 125 sub forbidden_module($); |
|
Line 125 sub forbidden_module($); |
|
use Cwd; |
use Cwd; |
|
|
# == EDIT this == |
# == EDIT this == |
# User configuration is stored in |
# Locations to search for user configuration, in order: |
$config = undef; |
for ( |
|
$ENV{CVSWEB_CONFIG}, |
for ($ENV{CVSWEB_CONFIG}, |
|
# '/home/knu/etc/cvsweb.conf', |
|
'/usr/local/etc/cvsweb.conf', |
'/usr/local/etc/cvsweb.conf', |
getcwd . '/cvsweb.conf') { |
getcwd() . '/cvsweb.conf' |
$config = $_ if defined($_) && -r $_; |
) { |
|
$config = $_ if defined($_) && -r $_; |
} |
} |
|
|
# == Configuration defaults == |
# == Configuration defaults == |
Line 146 $allow_version_select = 1; |
|
Line 145 $allow_version_select = 1; |
|
# These are defined to allow checking with perl -cw |
# These are defined to allow checking with perl -cw |
%CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES = |
%CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES = |
%tags = %alltags = @tabcolors = (); |
%tags = %alltags = @tabcolors = (); |
$cvstreedefault = $body_tag = $body_tag_for_src = |
$cvstreedefault = $body_tag = $body_tag_for_src = |
$logo = $defaulttitle = $address = |
$logo = $defaulttitle = $address = |
$long_intro = $short_instruction = $shortLogLen = |
$long_intro = $short_instruction = $shortLogLen = |
$show_author = $dirtable = $tablepadding = $columnHeaderColorDefault = |
$show_author = $dirtable = $tablepadding = $columnHeaderColorDefault = |
Line 224 $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING}) |
|
Line 223 $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING}) |
|
@stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag); |
@stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag); |
|
|
if (-f $config) { |
if (-f $config) { |
do $config; |
do $config |
} |
|| &fatal("500 Internal Error", |
else { |
sprintf('Error in loading configuration file: %s<BR><BR>%s<BR>', |
|
$config, &htmlify($@))); |
|
} else { |
&fatal("500 Internal Error", |
&fatal("500 Internal Error", |
'Configuration not found. Set the variable <code>$config</code> ' |
'Configuration not found. Set the variable <code>$config</code> ' |
. 'in cvsweb.cgi, or the environment variable ' |
. 'in cvsweb.cgi, or the environment variable ' |
Line 278 foreach (keys %DEFAULTVALUE) |
|
Line 279 foreach (keys %DEFAULTVALUE) |
|
} |
} |
|
|
$barequery = ""; |
$barequery = ""; |
|
my @barequery; |
foreach (@stickyvars) { |
foreach (@stickyvars) { |
# construct a query string with the sticky non default parameters set |
# construct a query string with the sticky non default parameters set |
if (defined($input{$_}) && $input{$_} ne '' && |
if (defined($input{$_}) && $input{$_} ne '' && |
!(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_})) { |
!(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_})) { |
if ($barequery) { |
push @barequery, join('=', urlencode($_), urlencode($input{$_}); |
$barequery = $barequery . "&"; |
|
} |
|
my $thisval = urlencode($_) . "=" . urlencode($input{$_}); |
|
$barequery .= $thisval; |
|
} |
} |
} |
} |
# is there any query ? |
# is there any query ? |
if ($barequery) { |
if (@barequery) { |
|
$barequery = join('&', @barequery); |
$query = "?$barequery"; |
$query = "?$barequery"; |
$barequery = "&" . $barequery; |
$barequery = "&$barequery"; |
} |
} |
else { |
else { |
$query = ""; |
$query = ""; |
} |
} |
|
undef @barequery; |
|
|
# get actual parameters |
# get actual parameters |
$sortby = $input{"sortby"}; |
$sortby = $input{"sortby"}; |
Line 344 if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}}) |
|
Line 344 if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}}) |
|
$cvsroot = $CVSROOT{$cvstree}; |
$cvsroot = $CVSROOT{$cvstree}; |
|
|
# create icons out of description |
# create icons out of description |
foreach my $k (keys %ICONS) { |
my $k |
|
foreach $k (keys %ICONS) { |
no strict 'refs'; |
no strict 'refs'; |
my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}}; |
my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}}; |
if ($ipath) { |
if ($ipath) { |
Line 354 foreach my $k (keys %ICONS) { |
|
Line 355 foreach my $k (keys %ICONS) { |
|
${"${k}icon"} = $itxt; |
${"${k}icon"} = $itxt; |
} |
} |
} |
} |
|
undef $k; |
|
|
|
my $config_cvstree = "$config-$cvstree"; |
|
|
# Do some special configuration for cvstrees |
# Do some special configuration for cvstrees |
do "$config-$cvstree" if (-f "$config-$cvstree"); |
if (-f $config_cvstree) { |
|
do $config_cvstree |
|
|| &fatal("500 Internal Error", |
|
sprintf('Error in loading configuration file: %s<BR><BR>%s<BR>', |
|
$config_cvstree, &htmlify($@))); |
|
} |
|
undef $config_cvstree; |
|
|
$prcategories = '(?:' . join('|', @prcategories) . ')'; |
$prcategories = '(?:' . join('|', @prcategories) . ')'; |
$prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/; |
$prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/; |
Line 1133 sub doAnnotate($$) { |
|
Line 1143 sub doAnnotate($$) { |
|
($pathname = $where) =~ s/(Attic\/)?[^\/]*$//; |
($pathname = $where) =~ s/(Attic\/)?[^\/]*$//; |
($filename = $where) =~ s/^.*\///; |
($filename = $where) =~ s/^.*\///; |
|
|
http_header(); |
|
|
|
navigateHeader($scriptwhere,$pathname,$filename,$rev, "annotate"); |
|
print "<h3 align=center>Annotation of $pathname$filename, Revision $rev</h3>\n"; |
|
|
|
# this seems to be necessary |
# this seems to be necessary |
$| = 1; $| = 0; # Flush |
$| = 1; $| = 0; # Flush |
|
|
Line 1147 sub doAnnotate($$) { |
|
Line 1152 sub doAnnotate($$) { |
|
# the public domain. |
# the public domain. |
# we could abandon the use of rlog, rcsdiff and co using |
# we could abandon the use of rlog, rcsdiff and co using |
# the cvsserver in a similiar way one day (..after rewrite) |
# the cvsserver in a similiar way one day (..after rewrite) |
$pid = open2($reader, $writer, "cvs server") || fatal ("500 Internal Error", |
$pid = open2($reader, $writer, "cvs -Rl server") || fatal ("500 Internal Error", |
"Fatal Error - unable to open cvs for annotation"); |
"Fatal Error - unable to open cvs for annotation"); |
|
|
# OK, first send the request to the server. A simplified example is: |
# OK, first send the request to the server. A simplified example is: |
Line 1199 sub doAnnotate($$) { |
|
Line 1204 sub doAnnotate($$) { |
|
# were nicer about buffering, then we could just leave it open, I think. |
# were nicer about buffering, then we could just leave it open, I think. |
close ($writer) || die "cannot close: $!"; |
close ($writer) || die "cannot close: $!"; |
|
|
|
http_header(); |
|
|
|
navigateHeader($scriptwhere,$pathname,$filename,$rev, "annotate"); |
|
print "<h3 align=center>Annotation of $pathname$filename, Revision $rev</h3>\n"; |
|
|
# Ready to get the responses from the server. |
# Ready to get the responses from the server. |
# For example: |
# For example: |
# E Annotations for foo/xx |
# E Annotations for foo/xx |
Line 1231 sub doAnnotate($$) { |
|
Line 1241 sub doAnnotate($$) { |
|
} |
} |
elsif ($words[0] eq "M") { |
elsif ($words[0] eq "M") { |
$lineNr++; |
$lineNr++; |
my $lrev = substr ($_, 2, 13); |
(my $lrev = substr($_, 2, 13)) =~ y/ //d; |
my $lusr = substr ($_, 16, 9); |
(my $lusr = substr($_, 16, 9)) =~ y/ //d; |
my $line = substr ($_, 36); |
my $line = substr($_, 36); |
|
my $isCurrentRev = ($rev eq $lrev); |
# we should parse the date here .. |
# we should parse the date here .. |
if ($lrev eq $oldLrev) { |
if ($lrev eq $oldLrev) { |
$revprint = " "; |
$revprint = sprintf('%-8s', ''); |
} |
} |
else { |
else { |
$revprint = $lrev; $oldLusr = ""; |
$revprint = sprintf('%-8s', $lrev); |
$revprint =~ s`^(\S+)`<a href="${scriptwhere}${barequery}#rev$1">$1</A>`; # ` |
$revprint =~ s`\S+`<a href="${scriptwhere}${barequery}#rev$1">$&</A>`; # ` |
|
$oldLusr = ''; |
} |
} |
if ($lusr eq $oldLusr) { |
if ($lusr eq $oldLusr) { |
$usrprint = " "; |
$usrprint = ''; |
} |
} |
else { |
else { |
$usrprint = $lusr; |
$usrprint = $lusr; |
} |
} |
$oldLrev = $lrev; |
$oldLrev = $lrev; |
$oldLusr = $lusr; |
$oldLusr = $lusr; |
# is there a less timeconsuming way to strip spaces ? |
|
($lrev = $lrev) =~ s/\s+//g; |
|
my $isCurrentRev = ($rev eq $lrev); |
|
|
|
print "<b>" if ($isCurrentRev); |
# Set bold for text-based browsers only - graphical |
printf ("%8s%s%8s %4d:", $revprint, ($isCurrentRev ? "|" : " "), $usrprint, $lineNr); |
# browsers show bold fonts a bit wider than regular fonts, |
|
# so it looks irregular. |
|
print "<b>" if ($isCurrentRev && $is_textbased); |
|
|
|
printf ("%s%s %-8s %4d:", |
|
$revprint, |
|
$isCurrentRev ? '!' : ' ', |
|
$usrprint, |
|
$lineNr); |
print spacedHtmlText($line, $d{'tabstop'}); |
print spacedHtmlText($line, $d{'tabstop'}); |
print "</b>" if ($isCurrentRev); |
|
|
print "</b>" if ($isCurrentRev && $is_textbased); |
} |
} |
elsif ($words[0] eq "ok") { |
elsif ($words[0] eq "ok") { |
# We could complain about any text received after this, like the |
# We could complain about any text received after this, like the |