=================================================================== RCS file: /cvs/cvsweb/cvsweb.cgi,v retrieving revision 3.2 retrieving revision 3.3 diff -u -p -r3.2 -r3.3 --- cvsweb/cvsweb.cgi 2000/07/20 11:52:05 3.2 +++ cvsweb/cvsweb.cgi 2000/07/27 16:16:41 3.3 @@ -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.2 2000/07/20 11:52:05 knu Exp $ +# $Id: cvsweb.cgi,v 3.3 2000/07/27 16:16:41 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+)=(.*)/) { @@ -251,7 +259,7 @@ else { $hr_default = $input{'f'} eq 'h'; -$logsort = $input{"logsort"}; +$logsort = $input{'logsort'}; ## Default CVS-Tree @@ -276,10 +284,10 @@ foreach my $k (keys %ICONS) { no strict 'refs'; my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}}; if ($ipath) { - $ {"${k}icon"} = "\"$itxt\""; + ${"${k}icon"} = "\"$itxt\""; } else { - $ {"${k}icon"} = $itxt; + ${"${k}icon"} = $itxt; } } @@ -312,7 +320,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,12 +354,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; } @@ -907,7 +914,7 @@ sub revcmp { sub fatal { my($errcode, $errmsg) = @_; - if (defined($ENV{'MOD_PERL'})) { + if ($is_mod_perl) { Apache->request->status((split(/ /, $errcode))[0]); } else { @@ -921,7 +928,7 @@ 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); } @@ -1007,7 +1014,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\/)?[^\/]*$//; @@ -1053,7 +1060,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 "") { @@ -1061,12 +1068,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. @@ -1123,7 +1130,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); @@ -1160,7 +1167,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 @@ -1194,7 +1201,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 @@ -1317,7 +1324,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. @@ -1356,19 +1363,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'; } @@ -1377,8 +1384,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(); @@ -2019,11 +2026,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 "

\n"; + print <Request diff between arbitrary revisions +
+EOF if ($curbranch) { - print "Default branch: "; - print ($revsym{$curbranch} || $curbranch); + print "Default branch: ", ($revsym{$curbranch} || $curbranch); } else { print "No default branch"; @@ -2317,7 +2325,7 @@ sub navigateHeader ($$$$$) { $swhere = urlencode($filename) if ($swhere eq ""); print "<\!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">"; print "\n\n"; - print ''; + print ''; print "\n$path$filename - $title - $rev\n"; print "\n"; print ""; @@ -2373,14 +2381,14 @@ sub readableTime ($$) } $i--; $break = $breaks[$i]; - $retval = plural_write(int ($secs / $break), $desc{"$break"}); + $retval = plural_write(int ($secs / $break), $desc{$break}); if ($long == 1 && $i > 0) { my $rest = $secs % $break; $i--; $break = $breaks[$i]; my $resttime = plural_write(int ($rest / $break), - $desc{"$break"}); + $desc{$break}); if ($resttime) { $retval = $retval . ", " . $resttime; } @@ -2413,7 +2421,7 @@ sub clickablePath($$) { $retval = $retval . " / "; $wherepath = $wherepath . '/' . $_; my ($last) = "$wherepath/" eq "/$pathname" - || "$wherepath" eq "/$pathname"; + || $wherepath eq "/$pathname"; if ($clickLast || !$last) { $retval = $retval . "\n"; foreach $k (@foo) { print "\n"; } print "\n"; @@ -2618,7 +2626,6 @@ sub urlencode { sub http_header { my $content_type = shift || "text/html"; - my $is_mod_perl = defined($ENV{'MOD_PERL'}); if (defined($moddate)) { if ($is_mod_perl) { Apache->request->header_out(Last_modified => scalar gmtime($moddate) . " GMT"); @@ -2672,14 +2679,14 @@ sub http_header { sub html_header($) { my ($title) = @_; - my $version = '$Revision: 3.2 $'; + my $version = '$Revision: 3.3 $'; http_header(); print < $title - + $body_tag $logo

$title