=================================================================== RCS file: /cvs/cvsweb/cvsweb.cgi,v retrieving revision 1.1.1.13 retrieving revision 3.14 diff -u -p -r1.1.1.13 -r3.14 --- cvsweb/cvsweb.cgi 2000/12/07 12:45:50 1.1.1.13 +++ cvsweb/cvsweb.cgi 2000/08/24 15:53:11 3.14 @@ -9,7 +9,6 @@ # Ken Coar # Dick Balaska # Akinori MUSHA -# Jens-Uwe Mager # # Based on: # * Bill Fenners cvsweb.cgi revision 1.28 available from: @@ -42,8 +41,8 @@ # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # -# $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $ -# $kId: cvsweb.cgi,v 1.41 2000/12/06 18:19:12 knu Exp $ +# $zId: cvsweb.cgi,v 1.94 2000/08/24 06:41:22 hnordstrom Exp $ +# $Id: cvsweb.cgi,v 3.14 2000/08/24 15:53:11 knu Exp $ # ### @@ -52,22 +51,20 @@ use strict; use vars qw ( $config $allow_version_select $verbose %CVSROOT %CVSROOTdescr %MIRRORS %DEFAULTVALUE %ICONS %MTYPES - @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted %symrev %revsym @allrevisions %date %author @revdisplayorder - @revisions %state %difflines %log %branchpoint @revorder - $prcgi @prcategories $prcategories $mancgi + @revisions %state %difflines %log %branchpoint @revorder $prcgi + @prcategories $prcategories $checkoutMagic $doCheckout $scriptname $scriptwhere $where $pathinfo $Browser $nofilelinks $maycompress @stickyvars %funcline_regexp $is_mod_perl - $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased + $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased %input $query $barequery $sortby $bydate $byrev $byauthor - $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot - $mimetype $charset $defaultTextPlain $defaultViewable - $allow_compress $GZIPBIN $backicon $diricon $fileicon - $fullname $newname $cvstreedefault - $body_tag $body_tag_for_src $logo $defaulttitle $address - $long_intro $short_instruction $shortLogLen + $bylog $byfile $hr_default $logsort $cvstree $cvsroot + $mimetype $defaultTextPlain $defaultViewable $allow_compress + $GZIPBIN $backicon $diricon $fileicon $fullname $newname + $cvstreedefault $body_tag $logo $defaulttitle $address + $backcolor $long_intro $short_instruction $shortLogLen $show_author $dirtable $tablepadding $columnHeaderColorDefault $columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite $hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove @@ -75,29 +72,23 @@ use vars qw ( $difffontsize $inputTextSize $mime_types $allow_annotate $allow_markup $use_java_script $open_extern_window $extern_window_width $extern_window_height $edit_option_form - $show_subdir_lastmod $show_log_in_markup $v + $checkout_magic $show_subdir_lastmod $show_log_in_markup $v $navigationHeaderColor $tableBorderColor $markupLogColor $tabstop $state $annTable $sel $curbranch @HideModules $module $use_descriptions %descriptions @mytz $dwhere $moddate - $use_moddate $has_zlib $gzip_open - $LOG_FILESEPARATOR $LOG_REVSEPARATOR + $use_moddate ); sub printDiffSelect($); -sub printDiffLinks($$); -sub printLogSortSelect($); sub findLastModifiedSubdirs(@); -sub htmlify_sub(&$); sub htmlify($;$); -sub spacedHtmlText($;$); +sub spacedHtmlText($); sub link($$); sub revcmp($$); sub fatal($$); sub redirect($); sub safeglob($); sub getMimeTypeFromSuffix($); -sub head($;$); -sub scan_directives(@); sub doAnnotate($$); sub doCheckout($$); sub cvswebMarkup($$$); @@ -120,8 +111,6 @@ sub download_url($$;$); sub download_link($$$;$); sub toggleQuery($$); sub urlencode($); -sub htmlquote($); -sub htmlunquote($); sub http_header(;$); sub html_header($); sub html_footer(); @@ -132,13 +121,14 @@ sub forbidden_module($); use Cwd; # == EDIT this == -# Locations to search for user configuration, in order: -for ( - $ENV{CVSWEB_CONFIG}, +# User configuration is stored in +$config = undef; + +for ($ENV{CVSWEB_CONFIG}, +# '/home/knu/etc/cvsweb.conf', '/usr/local/etc/cvsweb.conf', - getcwd() . '/cvsweb.conf' - ) { - $config = $_ if defined($_) && -r $_; + getcwd . '/cvsweb.conf') { + $config = $_ if defined($_) && -r $_; } # == Configuration defaults == @@ -152,9 +142,8 @@ $allow_version_select = 1; # These are defined to allow checking with perl -cw %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES = %tags = %alltags = @tabcolors = (); -$cvstreedefault = $body_tag = $body_tag_for_src = -$logo = $defaulttitle = $address = -$long_intro = $short_instruction = $shortLogLen = +$cvstreedefault = $body_tag = $logo = $defaulttitle = $address = +$backcolor = $long_intro = $short_instruction = $shortLogLen = $show_author = $dirtable = $tablepadding = $columnHeaderColorDefault = $columnHeaderColorSorted = $hr_breakable = $showfunc = $hr_ignwhite = $hr_ignkeysubst = $diffcolorHeading = $diffcolorEmpty = $diffcolorRemove = @@ -162,68 +151,15 @@ $diffcolorChange = $diffcolorAdd = $diffcolorDarkChang $difffontsize = $inputTextSize = $mime_types = $allow_annotate = $allow_markup = $use_java_script = $open_extern_window = $extern_window_width = $extern_window_height = $edit_option_form = -$show_subdir_lastmod = $show_log_in_markup = $v = +$checkout_magic = $show_subdir_lastmod = $show_log_in_markup = $v = $navigationHeaderColor = $tableBorderColor = $markupLogColor = -$tabstop = $use_moddate = $moddate = $gzip_open = undef; +$tabstop = $use_moddate = $moddate = undef; -$LOG_FILESEPARATOR = q/^={77}$/; -$LOG_REVSEPARATOR = q/^-{28}$/; - -@DIFFTYPES = qw(h H u c s); -@DIFFTYPES{@DIFFTYPES} = ( - { - 'descr' => 'colored', - 'opts' => [ '-u' ], - 'colored' => 1, - }, - { - 'descr' => 'long colored', - 'opts' => [ '--unified=15' ], - 'colored' => 1, - }, - { - 'descr' => 'unified', - 'opts' => [ '-u' ], - 'colored' => 0, - }, - { - 'descr' => 'context', - 'opts' => [ '-c' ], - 'colored' => 0, - }, - { - 'descr' => 'side by side', - 'opts' => [ '--side-by-side', '--width=164' ], - 'colored' => 0, - }, - ); - -@LOGSORTKEYS = qw(cvs date rev); -@LOGSORTKEYS{@LOGSORTKEYS} = ( - { - 'descr' => 'Not sorted', - }, - { - 'descr' => 'Commit date', - }, - { - 'descr' => 'Revision', - }, - ); - - ##### End of configuration variables ##### use Time::Local; use IPC::Open2; -# Check if the zlib C library interface is installed, and if yes -# we can avoid using the extra gzip process. -eval { - require Compress::Zlib; -}; -$has_zlib = !$@; - $verbose = $v; $checkoutMagic = "~checkout~"; $pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : ''; @@ -245,13 +181,12 @@ $is_mod_perl = defined($ENV{MOD_PERL}); # per file, so disable the link at the icon # in this case: $Browser = $ENV{HTTP_USER_AGENT}; -$is_links = ($Browser =~ m`^Links `); $is_lynx = ($Browser =~ m`^Lynx/`i); $is_w3m = ($Browser =~ m`^w3m/`i); $is_msie = ($Browser =~ m`MSIE`); $is_mozilla3 = ($Browser =~ m`^Mozilla/[3-9]`); -$is_textbased = ($is_links || $is_lynx || $is_w3m); +$is_textbased = ($is_lynx || $is_w3m); $nofilelinks = $is_textbased; @@ -262,13 +197,13 @@ $nofilelinks = $is_textbased; # braindamaged MS-Internet Exploders claim that they # accept gzip .. but don't in fact and # display garbage then :-/ -# Turn off gzip if running under mod_perl and no zlib is available, -# piping does not work as expected inside the server. -$maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING}) - && $ENV{HTTP_ACCEPT_ENCODING} =~ m`gzip`) +# 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` || $is_mozilla3) && !$is_msie - && !($is_mod_perl && !$has_zlib)); + && !$is_mod_perl); # put here the variables we need in order # to hold our state - they will be added (with @@ -277,11 +212,9 @@ $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING}) @stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag); if (-f $config) { - do $config - || &fatal("500 Internal Error", - sprintf('Error in loading configuration file: %s

%s
', - $config, &htmlify($@))); -} else { + do $config; +} +else { &fatal("500 Internal Error", 'Configuration not found. Set the variable $config ' . 'in cvsweb.cgi, or the environment variable ' @@ -333,24 +266,25 @@ foreach (keys %DEFAULTVALUE) } $barequery = ""; -my @barequery; foreach (@stickyvars) { # construct a query string with the sticky non default parameters set if (defined($input{$_}) && $input{$_} ne '' && !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_})) { - push @barequery, join('=', urlencode($_), urlencode($input{$_})); + if ($barequery) { + $barequery = $barequery . "&"; + } + my $thisval = urlencode($_) . "=" . urlencode($input{$_}); + $barequery .= $thisval; } } # is there any query ? -if (@barequery) { - $barequery = join('&', @barequery); +if ($barequery) { $query = "?$barequery"; - $barequery = "&$barequery"; + $barequery = "&" . $barequery; } else { $query = ""; } -undef @barequery; # get actual parameters $sortby = $input{"sortby"}; @@ -375,7 +309,7 @@ else { $byfile = 1; } -$defaultDiffType = $input{'f'}; +$hr_default = $input{'f'} eq 'h'; $logsort = $input{'logsort'}; @@ -398,33 +332,21 @@ if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}}) $cvsroot = $CVSROOT{$cvstree}; # create icons out of description -my $k; -foreach $k (keys %ICONS) { +foreach my $k (keys %ICONS) { no strict 'refs'; my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}}; if ($ipath) { - ${"${k}icon"} = sprintf('%s', - htmlquote($ipath), htmlquote($itxt), $iwidth, $iheight) + ${"${k}icon"} = "\"$itxt\""; } else { ${"${k}icon"} = $itxt; } } -undef $k; -my $config_cvstree = "$config-$cvstree"; - # Do some special configuration for cvstrees -if (-f $config_cvstree) { - do $config_cvstree - || &fatal("500 Internal Error", - sprintf('Error in loading configuration file: %s

%s
', - $config_cvstree, &htmlify($@))); -} -undef $config_cvstree; +do "$config-$cvstree" if (-f "$config-$cvstree"); $prcategories = '(?:' . join('|', @prcategories) . ')'; -$prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/; $fullname = $cvsroot . '/' . $where; $mimetype = &getMimeTypeFromSuffix ($fullname); @@ -436,7 +358,7 @@ $defaultViewable = $allow_markup && viewable($mimetype # ge get an Internal Server Error if we try to pipe the # output through the nonexistent gzip .. # any more elegant ways to prevent this are welcome! -if ($allow_compress && $maycompress && !$has_zlib) { +if ($allow_compress && $maycompress) { foreach (split(/:/, $ENV{PATH})) { if (-x "$_/gzip") { $GZIPBIN = "$_/gzip"; @@ -530,63 +452,57 @@ elsif (-d $fullname) { } print "\n"; $infocols++; - printf '"; # do not display the other column-headers, if we do not have any files # with revision information: if (scalar(%fileinfo)) { $infocols++; - printf '"; $infocols++; - printf '"; if ($show_author) { $infocols++; - printf '"; } $infocols++; - printf '"; } elsif ($use_descriptions) { - printf '
', - $byfile ? $columnHeaderColorSorted : $columnHeaderColorDefault; - if ($byfile) { - print 'File'; - } else { - print &link('File', sprintf('./%s#dirlist', - &toggleQuery("sortby", "file"))); - } + print "
"; + print "" if (!$byfile); + print "File"; + print "" if (!$byfile); print "', - $byrev ? $columnHeaderColorSorted : $columnHeaderColorDefault; - if ($byrev) { - print 'Rev.'; - } else { - print &link('Rev.', sprintf('./%s#dirlist', - &toggleQuery("sortby", "rev"))); - } + print ""; + print "" if (!$byrev); + print "Rev."; + print "" if (!$byrev); print "', - $bydate ? $columnHeaderColorSorted : $columnHeaderColorDefault; - if ($bydate) { - print 'Age'; - } else { - print &link('Age', sprintf('./%s#dirlist', - &toggleQuery("sortby", "date"))); - } + print ""; + print "" if (!$bydate); + print "Age"; + print "" if (!$bydate); print "', - $byauthor ? $columnHeaderColorSorted : $columnHeaderColorDefault; - if ($byauthor) { - print 'Author'; - } else { - print &link('Author', sprintf('./%s#dirlist', - &toggleQuery("sortby", "author"))); - } + print ""; + print "" if (!$byauthor); + print "Author"; + print "" if (!$byauthor); print "', - $bylog ? $columnHeaderColorSorted : $columnHeaderColorDefault; - if ($bylog) { - print 'Last log entry'; - } else { - print &link('Last log entry', sprintf('./%s#dirlist', - &toggleQuery("sortby", "log"))); - } + print ""; + print "" if (!$bylog); + print "Last log entry"; + print "" if (!$bylog); print "', $columnHeaderColorDefault; + print ""; print "Description"; $infocols++; } @@ -611,9 +527,9 @@ elsif (-d $fullname) { closedir($dh); } - my $hideAtticToggleLink = $input{'hideattic'} ? '' : - &link('[Hide]', sprintf('./%s#dirlist', - &toggleQuery ("hideattic"))); + my $hideAtticToggleLink = "[Hide]" if (!$input{'hideattic'}); # Sort without the Attic/ pathname. # place directories first @@ -651,38 +567,38 @@ elsif (-d $fullname) { next if ($_ eq '..' && $where eq '/'); my ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}} if (defined($fileinfo{$_})); - printf '
', $tabcolors[$dirrow % 2] if $dirtable; + print "
" if ($dirtable); if ($_ eq '..') { - $url = "../$query"; + $url = "../" . $query; if ($nofilelinks) { print $backicon; } else { - print &link($backicon, $url); + print &link($backicon,$url); } - print " ", &link("Previous Directory", $url); + print " ", &link("Previous Directory",$url); } else { - $url = urlencode($_) . "/$query"; + $url = urlencode($_) . '/' . $query; print ""; if ($nofilelinks) { print $diricon; } else { - print &link($diricon, $url); + print &link($diricon,$url); } - print " ", &link("$_/", $url), $attic; + print " ", &link($_ . "/", $url), $attic; if ($_ eq "Attic") { - print "  "; - print &link("[Don't hide]", sprintf('./%s#dirlist', - &toggleQuery ("hideattic"))); + print "  [Don't hide]"; } } # Show last change in dir if ($filename) { print "  " if ($dirtable); if ($date) { - print " ", readableTime(time() - $date,0), ""; + print " " . readableTime(time() - $date,0) . ""; } if ($show_author) { print " " if ($dirtable); @@ -693,8 +609,8 @@ elsif (-d $fullname) { print "$filename/$rev"; print "
" if ($dirtable); if ($log) { - print " ", - &htmlify(substr($log,0,$shortLogLen)); + print " " + . &htmlify(substr($log,0,$shortLogLen)); if (length $log > 80) { print "..."; } @@ -704,7 +620,7 @@ elsif (-d $fullname) { else { my ($dwhere) = ($where ne "/" ? $where : "") . $_; if ($use_descriptions && defined $descriptions{$dwhere}) { - print "
 " if $dirtable; + print " " if $dirtable; print $descriptions{$dwhere}; } elsif ($dirtable && $infocols > 1) { # close the row with the appropriate number of @@ -735,7 +651,7 @@ elsif (-d $fullname) { next if (!defined($fileinfo{$_})); ($rev,$date,$log,$author) = @{$fileinfo{$_}}; $filesfound++; - printf '
', $tabcolors[$dirrow % 2] if $dirtable; + print "
" if ($dirtable); print ""; if ($nofilelinks) { print $fileicon; @@ -746,11 +662,11 @@ elsif (-d $fullname) { print " ", &link($_, $url), $attic; print " " if ($dirtable); download_link($fileurl, - $rev, $rev, - $defaultViewable ? "text/x-cvsweb-markup" : undef); + $rev, $rev, + $defaultViewable ? "text/x-cvsweb-markup" : undef); print " " if ($dirtable); if ($date) { - print " ", readableTime(time() - $date,0), ""; + print " " . readableTime(time() - $date,0) . ""; } if ($show_author) { print " " if ($dirtable); @@ -758,7 +674,7 @@ elsif (-d $fullname) { } print " " if ($dirtable); if ($log) { - print " ", &htmlify(substr($log,0,$shortLogLen)); + print " " . &htmlify(substr($log,0,$shortLogLen)); if (length $log > 80) { print "..."; } @@ -773,7 +689,7 @@ elsif (-d $fullname) { if ($dirtable && defined($tableBorderColor)) { print "
"; } - print( $dirtable == 1 ? "\n" : "\n" ); + print "". ($dirtable == 1) ? "" : "" . "\n"; if ($filesexists && !$filesfound) { print "

NOTE: There are $filesexists files, but none matches the current tag ($input{only_with_tag})\n"; @@ -793,8 +709,7 @@ elsif (-d $fullname) { foreach my $var (@stickyvars) { print "\n" if (defined($input{$var}) - && (!defined($DEFAULTVALUE{$var}) - || $input{$var} ne $DEFAULTVALUE{$var}) + && $input{$var} ne $DEFAULTVALUE{$var} && $input{$var} ne "" && $var ne "only_with_tag"); } @@ -831,9 +746,12 @@ elsif (-d $fullname) { print "Revision"; print "Log message"; print ""; - print "Sort log by: "; - printLogSortSelect(0); - print ""; + print "revisions by: \n"; + print ""; print "Diff format: "; printDiffSelect(0); print ""; @@ -853,18 +771,15 @@ elsif (-d $fullname) { elsif (-f $fullname . ',v') { if (defined($input{'rev'}) || $doCheckout) { &doCheckout($fullname, $input{'rev'}); - gzipclose(); exit; } if (defined($input{'annotate'}) && $allow_annotate) { &doAnnotate($input{'annotate'}); - gzipclose(); exit; } if (defined($input{'r1'}) && defined($input{'r2'})) { &doDiff($fullname, $input{'r1'}, $input{'tr1'}, $input{'r2'}, $input{'tr2'}, $input{'f'}); - gzipclose(); exit; } print("going to dolog($fullname)\n") if ($verbose); @@ -887,7 +802,6 @@ elsif (-d $fullname) { # e.g. foo.c &doDiff($fullname, $input{'r1'}, $input{'tr1'}, $input{'r2'}, $input{'tr2'}, $input{'f'}); - gzipclose(); exit; } elsif (($newname = $fullname) =~ s|/([^/]+)$|/Attic/$1| && @@ -921,49 +835,22 @@ elsif (-d $fullname) { } &fatal("404 Not Found","$where: no such file or directory"); } - -gzipclose(); ## End MAIN sub printDiffSelect($) { my ($use_java_script) = @_; - my $f = $input{'f'}; - - print '\n"; + print "

Annotation of $pathname$filename, Revision $rev

\n"; + # this seems to be necessary $| = 1; $| = 0; # Flush @@ -1294,7 +1085,7 @@ sub doAnnotate($$) { # the public domain. # we could abandon the use of rlog, rcsdiff and co using # the cvsserver in a similiar way one day (..after rewrite) - $pid = open2($reader, $writer, "cvs -Rl server") || fatal ("500 Internal Error", + $pid = open2($reader, $writer, "cvs server") || fatal ("500 Internal Error", "Fatal Error - unable to open cvs for annotation"); # OK, first send the request to the server. A simplified example is: @@ -1346,11 +1137,6 @@ sub doAnnotate($$) { # were nicer about buffering, then we could just leave it open, I think. close ($writer) || die "cannot close: $!"; - http_header(); - - navigateHeader($scriptwhere,$pathname,$filename,$rev, "annotate"); - print "

Annotation of $pathname$filename, Revision $rev

\n"; - # Ready to get the responses from the server. # For example: # E Annotations for foo/xx @@ -1366,15 +1152,7 @@ sub doAnnotate($$) { else { print "
";
     }
-
-    # prefetch several lines
-    my @buf = head($reader);
-
-    my %d = scan_directives(@buf);
-
-    while (@buf || !eof($reader)) {
-	$_ = @buf ? shift @buf : <$reader>;
-
+    while (<$reader>) {
 	my @words = split;
 	# Adding one is for the (single) space which follows $words[0].
 	my $rest = substr ($_, length ($words[0]) + 1);
@@ -1383,48 +1161,39 @@ sub doAnnotate($$) {
 	}
 	elsif ($words[0] eq "M") {
 	    $lineNr++;
-	    (my $lrev = substr($_, 2, 13)) =~ y/ //d;
-	    (my $lusr = substr($_, 16,  9)) =~ y/ //d;
-	    my $line = substr($_, 36);
-	    my $isCurrentRev = ($rev eq $lrev);
+	    my $lrev = substr ($_, 2, 13);
+	    my $lusr = substr ($_, 16,  9);
+	    my $line = substr ($_, 36);
 	    # we should parse the date here ..
 	    if ($lrev eq $oldLrev) {
-		$revprint = sprintf('%-8s', '');
+		$revprint = "             ";
 	    }
 	    else {
-		$revprint = sprintf('%-8s', $lrev);
-		$revprint =~ s`\S+`&link($&, "$scriptwhere$query#rev$&")`e;	# `
-		$oldLusr = '';
+		$revprint = $lrev; $oldLusr = "";
 	    }
 	    if ($lusr eq $oldLusr) {
-		$usrprint = '';
+		$usrprint = "         ";
 	    }
 	    else {
 		$usrprint = $lusr;
 	    }
 	    $oldLrev = $lrev;
 	    $oldLusr = $lusr;
+	    # is there a less timeconsuming way to strip spaces ?
+	    ($lrev = $lrev) =~ s/\s+//g;
+	    my $isCurrentRev = ($rev eq $lrev);
 
-	    # Set bold for text-based browsers only - graphical
-	    # browsers show bold fonts a bit wider than regular fonts,
-	    # so it looks irregular.
-	    print "" if ($isCurrentRev && $is_textbased);
-
-	    printf "%s%s %-8s %4d:",
-		    $revprint,
-		    $isCurrentRev ? '!' : ' ',
-		    $usrprint,
-		    $lineNr;
-	    print spacedHtmlText($line, $d{'tabstop'});
-
-	    print "" if ($isCurrentRev && $is_textbased);
+	    print "" if ($isCurrentRev);
+	    printf ("%8s%s%8s %4d:", $revprint, ($isCurrentRev ? "|" : " "), $usrprint, $lineNr);
+	    print spacedHtmlText($line);
+	    print "" if ($isCurrentRev);
 	}
 	elsif ($words[0] eq "ok") {
 	    # We could complain about any text received after this, like the
 	    # CVS command line client.  But for simplicity, we don't.
 	}
 	elsif ($words[0] eq "error") {
-	    fatal("500 Internal Error", "Error occured during annotate: $_");
+	    fatal ("500 Internal Error", "Error occured during annotate: $_");
 	}
     }
     if ($annTable) {
@@ -1445,13 +1214,9 @@ sub doCheckout($$) {
     my ($mimetype,$revopt);
     my $fh = do {local(*FH);};
 
-    if ($rev eq 'HEAD' || $rev eq '.') {
-	$rev = undef;
-    }
-
     # make sure the revisions a wellformed, for security
     # reasons ..
-    if (defined($rev) && $rev =~ /[^\w.]/) {
+    if (defined($rev) && !($rev =~ /^[\d\.]+$/)) {
 	&fatal("404 Not Found",
 		"Malformed query \"$ENV{QUERY_STRING}\"");
     }
@@ -1487,13 +1252,8 @@ sub doCheckout($$) {
     # Safely for a child process to read from.
     if (! open($fh, "-|")) { # child
       open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
-      exec("cvs", "-Rld", $cvsroot, "co", "-p", $revopt, $where);
+      exec("cvs", "-d", $cvsroot, "co", "-p", $revopt, $where);
     }
-
-    if (eof($fh)) {
-	&fatal("404 Not Found",
-	       "$where is not (any longer) pertinent");
-    }
 #===================================================================
 #Checking out squid/src/ftp.c
 #RCS:  /usr/src/CVS/squid/src/ftp.c,v
@@ -1513,7 +1273,12 @@ sub doCheckout($$) {
     }
     if ($filename ne $where) {
 	&fatal("500 Internal Error",
-	       "Unexpected output from cvs co: $cvsheader");
+	       "Unexpected output from cvs co: $cvsheader"
+	       . "

Check whether the directory $cvsroot/CVSROOT exists " + . "and the script has write-access to the CVSROOT/history " + . "file if it exists." + . "
The script needs to place lock files in the " + . "directory the file is in as well.
"); } $| = 1; @@ -1541,14 +1306,12 @@ sub cvswebMarkup($$$) { print "


"; print "
"; print "File: ", &clickablePath($where, 1); - print " ("; - &download_link($fileurl, $revision, "download"); - print ")"; + print " "; + &download_link(urlencode($fileurl), $revision, "(download)"); if (!$defaultTextPlain) { - print " ("; - &download_link($fileurl, $revision, "as text", + print " "; + &download_link(urlencode($fileurl), $revision, "(as text)", "text/plain"); - print ")"; } print "
\n"; if ($show_log_in_markup) { @@ -1561,26 +1324,16 @@ sub cvswebMarkup($$$) { $input{only_with_tag}; } print "
"; + my @content = <$filehandle>; my $url = download_url($fileurl, $revision, $mimetype); print "
"; if ($mimetype =~ /^image/) { - printf '
', htmlquote("$url$barequery"); + print "
"; } - elsif ($mimetype =~ m%^application/pdf%) { - printf '
', htmlquote("$url$barequery"); - } else { print "
";
-
-	# prefetch several lines
-	my @buf = head($filehandle);
-
-	my %d = scan_directives(@buf);
-
-	while (@buf || !eof($filehandle)) {
-	    $_ = @buf ? shift @buf : <$filehandle>;
-
-	    print spacedHtmlText($_, $d{'tabstop'});
+	foreach (@content) {
+	    print spacedHtmlText($_);
 	}
 	print "
"; } @@ -1589,7 +1342,7 @@ sub cvswebMarkup($$$) { sub viewable($) { my ($mimetype) = @_; - $mimetype =~ m%^((text|image)/|application/pdf)% ; + $mimetype =~ m%^(text|image)/%; } ############################### @@ -1598,7 +1351,7 @@ sub viewable($) { sub doDiff($$$$$$) { my($fullname, $r1, $tr1, $r2, $tr2, $f) = @_; my $fh = do {local(*FH);}; - my ($rev1, $rev2, $sym1, $sym2, $f1, $f2); + my ($rev1, $rev2, $sym1, $sym2, @difftype, $diffname, $f1, $f2); if ($r1 =~ /([^:]+)(:(.+))?/) { $rev1 = $1; @@ -1616,10 +1369,9 @@ sub doDiff($$$$$$) { $rev2 = $tr2; $sym2 = ""; } - # make sure the revisions a wellformed, for security # reasons .. - if ($rev1 =~ /[^\w.]/ || $rev2 =~ /[^\w.]/) { + if (!($rev1 =~ /^[\d\.]+$/) || !($rev2 =~ /^[\d\.]+$/)) { &fatal("404 Not Found", "Malformed query \"$ENV{QUERY_STRING}\""); } @@ -1632,18 +1384,36 @@ sub doDiff($$$$$$) { ($rev1, $sym1) = ($rev2, $sym2); ($rev2, $sym2) = ($tmp1, $tmp2); } - my $difftype = $DIFFTYPES{$f}; - - if (!$difftype) { + my $human_readable = 0; + if ($f eq 'c') { + @difftype = qw{-c}; + $diffname = "Context diff"; + } + elsif ($f eq 's') { + @difftype = qw{--side-by-side --width=164}; + $diffname = "Side by Side"; + } + elsif ($f eq 'H') { + $human_readable = 1; + @difftype = qw{--unified=15}; + $diffname = "Long Human readable"; + } + elsif ($f eq 'h') { + @difftype =qw{-u}; + $human_readable = 1; + $diffname = "Human readable"; + } + elsif ($f eq 'u') { + @difftype = qw{-u}; + $diffname = "Unidiff"; + } + else { fatal ("400 Bad arguments", "Diff format $f not understood"); } - my @difftype = @{$difftype->{'opts'}}; - my $human_readable = $difftype->{'colored'}; - # apply special options if ($showfunc) { - push @difftype, '-p' if $f ne 's'; + push @difftype, '-p'; my($re1, $re2); @@ -1669,7 +1439,6 @@ sub doDiff($$$$$$) { if ($human_readable) { http_header(); &human_readable_diff($fh, $rev2); - gzipclose(); exit; } else { @@ -1705,14 +1474,14 @@ sub doDiff($$$$$$) { s|$cvsroot/||o; if ($sym1) { chop; - $_ .= " $sym1\n"; + $_ .= " " . $sym1 . "\n"; } } elsif (m|^$f2 $cvsroot|o) { s|$cvsroot/||o; if ($sym2) { chop; - $_ .= " $sym2\n"; + $_ .= " " . $sym2 . "\n"; } } print $_; @@ -1780,67 +1549,64 @@ sub getDirLogs($$@) { again: if ($state eq "head") { #$rcsfile = $1 if (/^RCS file: (.+)$/); #not used (yet) - - if (/^Working file: (.+)$/) { - $filename = $1; - } elsif (/^head: (.+)$/) { - $head = $1; - } elsif (/^branch: (.+)$/) { - $branch = $1 - } elsif (/^symbolic names:/) { - $state = "tags"; - ($branch = $head) =~ s/\.\d+$// if (!defined($branch)); - $branch =~ s/(\.?)(\d+)$/${1}0.$2/; - $symrev{MAIN} = $branch; - $symrev{HEAD} = $branch; - $alltags{MAIN} = 1; - $alltags{HEAD} = 1; - push (@filetags, "MAIN", "HEAD"); - } elsif (/$LOG_REVSEPARATOR/o) { - $state = "log"; - $rev = undef; - $date = undef; - $log = ""; - # Try to reconstruct the relative filename if RCS spits out a full path - $filename =~ s%^\Q$DirName\E/%%; - } + $filename = $1 if (/^Working file: (.+)$/); + $head = $1 if (/^head: (.+)$/); + $branch = $1 if (/^branch: (.+)$/); + } + if ($state eq "head" && /^symbolic names/) { + $state = "tags"; + ($branch = $head) =~ s/\.\d+$// if (!defined($branch)); + $branch =~ s/(\.?)(\d+)$/${1}0.$2/; + $symrev{MAIN} = $branch; + $symrev{HEAD} = $branch; + $alltags{MAIN} = 1; + $alltags{HEAD} = 1; + push (@filetags, "MAIN", "HEAD"); next; } - if ($state eq "tags") { - if (/^\s+(.+):\s+([\d\.]+)\s+$/) { - push (@filetags, $1); - $symrev{$1} = $2; - $alltags{$1} = 1; + if ($state eq "tags" && + /^\s+(.+):\s+([\d\.]+)\s+$/) { + push (@filetags, $1); + $symrev{$1} = $2; + $alltags{$1} = 1; + next; + } + if ($state eq "tags" && /^\S/) { + if (defined($tag) && (defined($symrev{$tag}) || $tag eq "HEAD")) { + $revwanted = $tag eq "HEAD" ? $symrev{"MAIN"} : $symrev{$tag}; + ($branch = $revwanted) =~ s/\b0\.//; + ($branchpoint = $branch) =~ s/\.?\d+$//; + $revwanted = undef if ($revwanted ne $branch); + } + elsif (defined($tag) && $tag ne "HEAD") { + print "Tag not found, skip this file" if ($verbose); + $state = "skip"; next; - } elsif (/^\S/) { - if (defined($tag)) { - if(defined($symrev{$tag}) || $tag eq "HEAD") { - $revwanted = $symrev{$tag eq "HEAD" ? "MAIN" : $tag}; - ($branch = $revwanted) =~ s/\.0\././; - ($branchpoint = $branch) =~ s/\.?\d+$//; - $revwanted = undef if ($revwanted ne $branch); -#print "\n[revwanted=$revwanted]"; - } elsif ($tag ne "HEAD") { - print "Tag not found, skip this file" if ($verbose); - $state = "skip"; - next; - } - } - foreach my $tagfound (@filetags) { - $tags{$tagfound} = 1; - } - $state = "head"; - goto again; } + foreach my $tagfound (@filetags) { + $tags{$tagfound} = 1; + } + $state = "head"; + goto again; } + if ($state eq "head" && /^----------------------------$/) { + $state = "log"; + $rev = undef; + $date = undef; + $log = ""; + # Try to reconstruct the relative filename if RCS spits out a full path + $filename =~ s%^\Q$DirName\E/%%; + next; + } if ($state eq "log") { - if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) { + if (/^----------------------------$/ + || /^=============================/) { # End of a log entry. my $revbranch; ($revbranch = $rev) =~ s/\.\d+$//; - print "$filename $rev Wanted: $revwanted ", - "Revbranch: $revbranch Branch: $branch ", - "Branchpoint: $branchpoint\n" if ($verbose); + print "$filename $rev Wanted: $revwanted " + . "Revbranch: $revbranch Branch: $branch " + . "Branchpoint: $branchpoint\n" if ($verbose); if (!defined($revwanted) && defined($branch) && $branch eq $revbranch || !defined($tag)) { print "File revision $rev found for branch $branch\n" @@ -1878,10 +1644,10 @@ again: next; } else { - $log .= $_; + $log = $log . $_; } } - if (/$LOG_FILESEPARATOR/o) { + if (/^===============/) { $state = "start"; next; } @@ -1955,7 +1721,7 @@ sub readLog($;$) { # log info # ---------------------------- logentry: - while (!/$LOG_FILESEPARATOR/o) { + while (!/^=========/) { $_ = <$fh>; last logentry if (!defined($_)); # EOF print "R:", $_ if ($verbose); @@ -1963,7 +1729,7 @@ sub readLog($;$) { $rev = $1; unshift(@allrevisions,$rev); } - elsif (/$LOG_FILESEPARATOR/o || /$LOG_REVSEPARATOR/o) { + elsif (/^========/ || /^----------------------------$/) { next logentry; } else { @@ -1997,7 +1763,7 @@ sub readLog($;$) { while (<$fh>) { print "L:", $_ if ($verbose); next line if (/^branches:\s/); - last line if (/$LOG_FILESEPARATOR/o || /$LOG_REVSEPARATOR/o); + last line if (/^----------------------------$/ || /^=========/); $log{$rev} .= $_; } print "E:", $_ if ($verbose); @@ -2016,10 +1782,11 @@ sub readLog($;$) { # This is not neccesary the same revision as marked as head in the RCS file. my $headrev = $curbranch || "1"; ($symrev{"MAIN"} = $headrev) =~ s/(\.?)(\d+)$/${1}0.$2/; + revision: foreach $rev (@revorder) { if ($rev =~ /^(\S*)\.\d+$/ && $headrev eq $1) { $symrev{"HEAD"} = $rev; - last; + last revision; } } ($symrev{"HEAD"} = $headrev) =~ s/\.\d+$// @@ -2037,7 +1804,7 @@ sub readLog($;$) { foreach (reverse sort keys %symrev) { $rev = $symrev{$_}; - if ($rev =~ /^((.*)\.)0\.(\d+)$/) { + if ($rev =~ /^((.*)\.)?\b0\.(\d+)$/) { push(@branchnames, $_); # # A revision number of A.B.0.D really translates into @@ -2050,22 +1817,21 @@ sub readLog($;$) { # with the branch number 0.A, with the exception that # it has no head to translate to if there is nothing on # the branch, but I guess this can never happen? + # (the code below gracefully forgets about the branch + # if it should happen) # - # Since some stupid people actually import/check in - # files with version 0.X we assume that the above cannot - # happen, and regard 0.X(.*) as a revision and not a branch. - # $head = defined($2) ? $2 : ""; $branch = $3; $branchrev = $head . ($head ne "" ? "." : "") . $branch; my $regex; - $regex = quotemeta $branchrev; + ($regex = $branchrev) =~ s/\./\\./g; $rev = $head; + revision: foreach my $r (@revorder) { if ($r =~ /^${regex}\b/) { $rev = $branchrev; - last; + last revision; } } next if ($rev eq ""); @@ -2083,7 +1849,7 @@ sub readLog($;$) { my ($onlyonbranch, $onlybranchpoint); if ($onlyonbranch = $input{'only_with_tag'}) { $onlyonbranch = $symrev{$onlyonbranch}; - if ($onlyonbranch =~ s/\.0\././) { + if ($onlyonbranch =~ s/\b0\.//) { ($onlybranchpoint = $onlyonbranch) =~ s/\.\d+$//; } else { @@ -2121,20 +1887,6 @@ sub readLog($;$) { } -sub printDiffLinks($$) { - my($text, $url) = @_; - my @extra; - - local $_; - for ($DIFFTYPES{$defaultDiffType}{'colored'} ? qw(u) : qw(h)) { - my $f = $_ eq $defaultDiffType ? '' : $_; - - push @extra, &link(lc $DIFFTYPES{$_}{'descr'}, "$url&f=$f"); - } - - print &link($text, $url), ' (', join(', ', @extra), ')'; -} - sub printLog($;$) { my ($link, $br, $brp); ($_,$link) = @_; @@ -2163,40 +1915,29 @@ sub printLog($;$) { } print "\n Revision "; &download_link($fileurl, $_, $_, - $defaultViewable ? "text/x-cvsweb-markup" : undef); + $defaultViewable ? "text/x-cvsweb-markup" : undef); if ($defaultViewable) { - print " / ("; - &download_link($fileurl, $_, "download", $mimetype); - print ")"; + print " / "; + &download_link($fileurl, $_, "(download)", $mimetype); } if (not $defaultTextPlain) { - print " / ("; - &download_link($fileurl, $_, "as text", "text/plain"); - print ")"; + print " / "; + &download_link($fileurl, $_, "(as text)", + "text/plain"); } if (!$defaultViewable) { - print " / ("; - &download_link($fileurl, $_, "view", "text/x-cvsweb-markup"); - print ")"; + print " / "; + &download_link($fileurl, $_, "(view)", "text/x-cvsweb-markup"); } if ($allow_annotate) { - print " - "; - print &link('annotate', - sprintf('%s/%s?annotate=%s%s', - $scriptname, - urlencode($where), - $_, - $barequery)); + print " - "; + print "annotate"; } # Plus a select link if enabled, and this version isn't selected if ($allow_version_select) { if ((!defined($input{"r1"}) || $input{"r1"} ne $_)) { - print " - "; - print &link('[select for diffs]', - sprintf('%s?r1=%s%s', - $scriptwhere, - $_, - $barequery)); + print " - [select for diffs]\n"; } else { print " - [selected]"; @@ -2211,13 +1952,13 @@ sub printLog($;$) { } if (defined @mytz) { my ($est) = $mytz[(localtime($date{$_}))[8]]; - print ", ", scalar localtime($date{$_}), " $est ("; + print ", " . scalar localtime($date{$_}) . " $est ("; } else { - print ", ", scalar gmtime($date{$_}), " UTC ("; + print ", " . scalar gmtime($date{$_}) . " UTC ("; } - print readableTime(time() - $date{$_},1), " ago)"; + print readableTime(time() - $date{$_},1) . " ago)"; print " by "; - print "", $author{$_}, "\n"; + print "" . $author{$_} . "\n"; print "
Branch: ",$link?link_tags($revsym{$br}):$revsym{$br},"\n" if ($revsym{$br}); print "
CVS Tags: ",$link?link_tags($revsym{$_}):$revsym{$_},"" @@ -2251,28 +1992,23 @@ sub printLog($;$) { # Offer diff to previous revision if ($prev) { $diffrev{$prev} = 1; - - my $url = sprintf('%s.diff?r1=%s&r2=%s%s', - $scriptwhere, - $prev, - $_, - $barequery); - - print " to previous "; - printDiffLinks($prev, $url); + print " to previous $prev\n"; + if (!$hr_default) { # offer a human readable version if not default + print "(colored)\n"; + } } # # Plus, if it's on a branch, and it's not a vendor branch, # offer a diff with the branch point. if ($revsym{$brp} && !/^1\.1\.1\.\d+$/ && !defined($diffrev{$brp})) { - my $url = sprintf('%s.diff?r1=%s&r2=%s%s', - $scriptwhere, - $brp, - $_, - $barequery); - - print " to branchpoint "; - printDiffLinks($brp, $url); + print " to branchpoint $brp\n"; + if (!$hr_default) { # offer a human readable version if not default + print "(colored)\n"; + } } # # Plus, if it's on a branch, and it's not a vendor branch, @@ -2297,30 +2033,29 @@ sub printLog($;$) { } if (!defined($diffrev{$nextmain})) { $diffrev{$nextmain} = 1; - - my $url = sprintf('%s.diff?r1=%s&r2=%s%s', - $scriptwhere, - $nextmain, - $_, - $barequery); - - print " next main "; - printDiffLinks($nextmain, $url); + print " next main $nextmain\n"; + if (!$hr_default) { # offer a human readable version if not default + print "(colored)\n"; + } } } # Plus if user has selected only r1, then present a link # to make a diff to that revision if (defined($input{"r1"}) && !defined($diffrev{$input{"r1"}})) { $diffrev{$input{"r1"}} = 1; + print " to selected $input{'r1'}\n"; + if (!$hr_default) { # offer a human readable version if not default + print "(colored)\n"; - my $url = sprintf('%s.diff?r1=%s&r2=%s%s', - $scriptwhere, - $input{'r1'}, - $_, - $barequery); - - print " to selected "; - printDiffLinks($input{'r1'}, $url); + } } } print "
\n";
@@ -2339,10 +2074,11 @@ sub doLog($) {
         ($filename = $where) =~ s|^.*/||;
         $backurl = $scriptname . "/" . urlencode($upwhere) . $query;
 	print &link($backicon, "$backurl#$filename"),
-	  " Up to ", &clickablePath($upwhere, 1), "

\n"; - print &link('Request diff between arbitrary revisions', '#diff'); - print '


'; - + " Up to ", &clickablePath($upwhere, 1), "

\n"; + print <Request diff between arbitrary revisions +


+EOF if ($curbranch) { print "Default branch: ", ($revsym{$curbranch} || $curbranch); } @@ -2370,44 +2106,42 @@ sub doLog($) { print "

\n"; print "

\n"; foreach (@stickyvars) { - printf('', $_, $input{$_}) + print "\n" if (defined($input{$_}) - && ((!defined($DEFAULTVALUE{$_}) - || $input{$_} ne $DEFAULTVALUE{$_}) - && $input{$_} ne "")); + && ($input{$_} ne $DEFAULTVALUE{$_} && $input{$_} ne "")); } - print "\n"; - print ""; - print "\n"; - print ""; - print "\n"; + print "\n"; + print "
Type of Diff should be a "; + printDiffSelect(0); + print "\n"; print "\n"; - print "
Diffs between \n"; + print "Diffs between \n"; print "\n"; $diffrev = $revdisplayorder[$#revdisplayorder]; $diffrev = $input{"r1"} if (defined($input{"r1"})); - print "
and \n"; + print "\n"; + print " and \n"; print "\n"; $diffrev = $revdisplayorder[0]; $diffrev = $input{"r2"} if (defined($input{"r2"})); - print "
\n"; print "
\n"; - print ""; - print "\n"; - print ""; - print "\n"; if (@branchnames) { - print ""; - print "\n"; + print "\n"; + print "\n"; + print "\n"; } + print "\n"; + print "\n"; foreach (@stickyvars) { - next if ($_ eq "f"); next if ($_ eq "only_with_tag"); next if ($_ eq "logsort"); print "\n" - if (defined($input{$_}) - && (!defined($DEFAULTVALUE{$_}) - || $input{$_} ne $DEFAULTVALUE{$_}) + if (defined($input{$_}) && $input{$_} ne $DEFAULTVALUE{$_} && $input{$_} ne ""); } - print ""; - print ""; - print ""; + print "Sort log by: \n"; + print "\n"; + print "\n"; print "\n"; - print "
Preferred Diff type:"; - printDiffSelect($use_java_script); - print "
View only Branch:"; print "\n"; + print "\n"; + foreach (@stickyvars) { + next if ($_ eq "only_with_tag"); + next if ($_ eq "logsort"); + print "\n" + if (defined($input{$_}) && $input{$_} ne $DEFAULTVALUE{$_} + && $input{$_} ne ""); + } + print "View only Branch: \n"; print "
"; - print "\n"; - print "Sort log by:"; - printLogSortSelect($use_java_script); - print "
"; print &html_footer; print "\n"; } @@ -2481,7 +2217,7 @@ sub flush_diff_rows($$$$) { # human_readable_diff(String revision_to_return_to); ## sub human_readable_diff($){ - my ($difftxt, $where_nd, $filename, $pathname, $scriptwhere_nd); + my ($i,$difftxt, $where_nd, $filename, $pathname, $scriptwhere_nd); my ($fh, $rev) = @_; my ($date1, $date2, $r1d, $r2d, $r1r, $r2r, $rev1, $rev2, $sym1, $sym2); my (@rightCol, @leftCol); @@ -2508,16 +2244,17 @@ sub human_readable_diff($){ $date2 = $r2d; } - print "

Diff for /$where_nd between version $rev1 and $rev2

\n", - "\n", - "\n", - "
", - "version $rev1"; + print "

Diff for /$where_nd between version $rev1 and $rev2

\n"; + + print "\n"; + print "\n"; + print "\n", - "\n"; + print "\n"; @@ -2534,15 +2271,9 @@ sub human_readable_diff($){ # cascading style sheets because we've to set the # font and color for each row. anyone ...? #### + while (<$fh>) { + $difftxt = $_; - # prefetch several lines - my @buf = head($fh); - - my %d = scan_directives(@buf); - - while (@buf || !eof($fh)) { - $difftxt = @buf ? shift @buf : <$fh>; - if ($difftxt =~ /^@@/) { ($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/; print "
"; + print "version $rev1"; print ", $date1" if (defined($date1)); print "
Tag: $sym1\n" if ($sym1); - print "
", - "version $rev2"; + print ""; + print "version $rev2"; print ", $date2" if (defined($date2)); print "
Tag: $sym2\n" if ($sym1); print "
"; @@ -2558,7 +2289,7 @@ sub human_readable_diff($){ } else { ($diffcode,$rest) = $difftxt =~ /^([-+ ])(.*)/; - $_ = spacedHtmlText($rest, $d{'tabstop'}); + $_ = spacedHtmlText ($rest); # Add fontface, size $_ = "$fs $_$fe"; @@ -2642,12 +2373,12 @@ 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 "$body_tag_for_src\n"; + print "\n"; print ""; print ""; @@ -2658,10 +2389,10 @@ sub navigateHeader($$$$$) { sub plural_write($$) { my ($num,$text) = @_; if ($num != 1) { - $text .= "s"; + $text = $text . "s"; } if ($num > 0) { - return join(' ', $num, $text); + return $num . " " . $text; } else { return ""; @@ -2705,7 +2436,7 @@ sub readableTime($$) { my $resttime = plural_write(int ($rest / $break), $desc{$break}); if ($resttime) { - $retval .= ", $resttime"; + $retval = $retval . ", " . $resttime; } } @@ -2729,26 +2460,24 @@ sub clickablePath($$) { $retval = "[$cvstree]"; } else { - $retval .= ' ' . &link("[$cvstree]", sprintf('%s/%s#dirlist', - $scriptname, - $query)); + $retval = $retval . " [$cvstree]"; my $wherepath = ''; my ($lastslash) = $pathname =~ m|/$|; foreach (split(/\//, $pathname)) { - $retval .= " / "; - $wherepath .= "/$_"; + $retval = $retval . " / "; + $wherepath = $wherepath . '/' . $_; my ($last) = "$wherepath/" eq "/$pathname" || $wherepath eq "/$pathname"; if ($clickLast || !$last) { - $retval .= &link($_, join('', - $scriptname, - urlencode($wherepath), - (!$last || $lastslash ? '/' : ''), - $query, - (!$last || $lastslash ? "#dirlist" : ""))); + $retval = $retval . "$_"; } else { # do not make a link to the current dir - $retval .= $_; + $retval = $retval . $_; } } } @@ -2780,7 +2509,8 @@ sub chooseCVSRoot() { foreach $k (@foo) { print "\n"; + print ">" . ($CVSROOTdescr{$k} ? $CVSROOTdescr{$k} : + $k). "\n"; } print "\n"; print ""; @@ -2804,7 +2534,7 @@ sub chooseMirror() { print "\nThis cvsweb is mirrored in:\n"; foreach $mirror (keys %MIRRORS) { print ", " if ($moremirrors); - print &link(htmlquote($mirror),$MIRRORS{$mirror}); + print qq($mirror\n); $moremirrors = 1; } print "

\n"; @@ -2845,30 +2575,34 @@ sub fileSortCmp() { sub download_url($$;$) { my ($url,$revision,$mimetype) = @_; - $revision =~ s/\.0\././; + $revision =~ s/\b0\.//; - if (defined($checkoutMagic) + if (defined($checkout_magic) && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) { - my $path = $where; - $path =~ s|/[^/]*$|/|; + my ($path); + ($path = $where) =~ s|/[^/]*$|/|; $url = "$scriptname/$checkoutMagic/${path}$url"; } $url .= "?rev=$revision"; - $url .= '&content-type=' . urlencode($mimetype) if (defined($mimetype)); + $url .= "&content-type=$mimetype" if (defined($mimetype)); - $url; + return $url; } # Presents a link to download the # selected revision sub download_link($$$;$) { - my ($url, $revision, $textlink, $mimetype) = @_; - my ($fullurl) = download_url($url, $revision, $mimetype); - - printf '$textlink"; + print ")" if ($paren); } # Returns a Query string with the @@ -2924,7 +2653,7 @@ sub toggleQuery($$) { my ($value) = defined($vars{$var}) ? $vars{$var} : ""; my ($default) = defined($DEFAULTVALUE{$var}) ? $DEFAULTVALUE{$var} : ""; if ($value ne $default) { - $newquery .= "&" if ($newquery ne ""); + $newquery .= "&" if ($newquery ne ""); $newquery .= urlencode($var) . "=" . urlencode($value); } } @@ -2935,46 +2664,20 @@ sub toggleQuery($$) { } sub urlencode($) { - local($_) = @_; - - s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge; - - - $_; + my ($in) = @_; + my ($out); + ($out = $in) =~ s/([\000-+{-\377])/sprintf("%%%02x", ord($1))/ge; + return $out; } -sub htmlquote($) { - local($_) = @_; - - # Special Characters; RFC 1866 - s/&/&/g; - s/\"/"/g; - s//>/g; - - $_; -} - -sub htmlunquote($) { - local($_) = @_; - - # Special Characters; RFC 1866 - s/"/\"/g; - s/<//g; - s/&/&/g; - - $_; -} - sub http_header(;$) { my $content_type = shift || "text/html"; if (defined($moddate)) { if ($is_mod_perl) { - Apache->request->header_out("Last-Modified" => scalar gmtime($moddate) . " GMT"); + Apache->request->header_out(Last_modified => scalar gmtime($moddate) . " GMT"); } else { - print "Last-Modified: ", scalar gmtime($moddate), " GMT\r\n"; + print "Last-Modified: " . scalar gmtime($moddate) . " GMT\r\n"; } } if ($is_mod_perl) { @@ -2984,7 +2687,8 @@ sub http_header(;$) { print "Content-type: $content_type\r\n"; } if ($allow_compress && $maycompress) { - if ($has_zlib || (defined($GZIPBIN) && open(GZIP, "|$GZIPBIN -1 -c"))) { + my $fh = do {local(*FH);}; + if (defined($GZIPBIN) && open($fh, "|$GZIPBIN -1 -c")) { if ($is_mod_perl) { Apache->request->content_encoding("x-gzip"); Apache->request->header_out(Vary => "Accept-Encoding"); @@ -2996,12 +2700,8 @@ sub http_header(;$) { print "\r\n"; # Close headers } $| = 1; $| = 0; # Flush header output - if ($has_zlib) { - tie *GZIP, __PACKAGE__, \*STDOUT; - } - select(GZIP); - $gzip_open = 1; -# print "" if ($content_type =~ m|^text/html\b|); + select ($fh); +# print "" if ($content_type eq "text/html"); } else { if ($is_mod_perl) { @@ -3025,13 +2725,12 @@ sub http_header(;$) { sub html_header($) { my ($title) = @_; - my $version = '$zRevision: 1.104 $ $kRevision: 1.41 $'; #' - http_header($charset ne "" ? "text/html; charset=$charset" : "text/html"); + my $version = '$zRevision: 1.94 $ $Revision: 3.14 $'; #' + http_header(); print < - $title @@ -3054,9 +2753,10 @@ sub link_tags($) { foreach my $sym (split(", ", $tags)) { $ret .= ",\n" if ($ret ne ""); - $ret .= &link($sym, $fileurl . toggleQuery('only_with_tag',$sym)); + $ret .= "$sym"; } - return "$ret\n"; + return $ret."\n"; } # @@ -3070,83 +2770,4 @@ sub forbidden_module($) { } return 0; -} - -# Close the GZIP handle remove the tie. - -sub gzipclose { - if ($gzip_open) { - select(STDOUT); - close(GZIP); - untie *GZIP; - $gzip_open = 0; - } -} - -# implement a gzipped file handle via the Compress:Zlib compression -# library. - -sub MAGIC1() { 0x1f } -sub MAGIC2() { 0x8b } -sub OSCODE() { 3 } - -sub TIEHANDLE { - my ($class, $out) = @_; - my ($d) = Compress::Zlib::deflateInit(-Level => Compress::Zlib::Z_BEST_COMPRESSION(), - -WindowBits => -Compress::Zlib::MAX_WBITS()) or return undef; - my ($o) = { - handle => $out, - dh => $d, - crc => 0, - len => 0, - }; - my ($header) = pack("c10", MAGIC1, MAGIC2, Compress::Zlib::Z_DEFLATED(), 0,0,0,0,0,0, OSCODE); - print {$o->{handle}} $header; - return bless($o, $class); -} - -sub PRINT { - my ($o) = shift; - my ($buf) = join(defined $, ? $, : "",@_); - my ($len) = length($buf); - my ($compressed, $status) = $o->{dh}->deflate($buf); - print {$o->{handle}} $compressed if defined($compressed); - $o->{crc} = Compress::Zlib::crc32($buf, $o->{crc}); - $o->{len} += $len; - return $len; -} - -sub PRINTF { - my ($o) = shift; - my ($fmt) = shift; - my ($buf) = sprintf($fmt, @_); - my ($len) = length($buf); - my ($compressed, $status) = $o->{dh}->deflate($buf); - print {$o->{handle}} $compressed if defined($compressed); - $o->{crc} = Compress::Zlib::crc32($buf, $o->{crc}); - $o->{len} += $len; - return $len; -} - -sub WRITE { - my ($o, $buf, $len, $off) = @_; - my ($compressed, $status) = $o->{dh}->deflate(substr($buf, 0, $len)); - print {$o->{handle}} $compressed if defined($compressed); - $o->{crc} = Compress::Zlib::crc32(substr($buf, 0, $len), $o->{crc}); - $o->{len} += $len; - return $len; -} - -sub CLOSE { - my ($o) = @_; - return if !defined( $o->{dh}); - my ($buf) = $o->{dh}->flush(); - $buf .= pack("V V", $o->{crc}, $o->{len}); - print {$o->{handle}} $buf; - undef $o->{dh}; -} - -sub DESTROY { - my ($o) = @_; - CLOSE($o); }

"; - print &link($backicon, "$swhere$query#rev$rev"); + print "$backicon"; print " Return to ", &link("$filename","$swhere$query#rev$rev")," CVS log"; print " $fileicon