===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1.1.18
retrieving revision 3.36
diff -u -p -r1.1.1.18 -r3.36
--- cvsweb/cvsweb.cgi 2001/01/01 23:55:44 1.1.1.18
+++ cvsweb/cvsweb.cgi 2000/10/20 12:28:45 3.36
@@ -42,8 +42,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.54 2001/01/01 23:15:02 knu Exp $
+# $zId: cvsweb.cgi,v 1.103 2000/09/20 17:02:29 jumager Exp $
+# $Id: cvsweb.cgi,v 3.36 2000/10/20 12:28:45 knu Exp $
#
###
@@ -52,21 +52,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 $re_prcategories $prkeyword $re_prkeyword $mancgi
+ $prcgi @prcategories $prcategories $mancgi
$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
%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
+ $bylog $byfile $hr_default $logsort $cvstree $cvsroot
+ $mimetype $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
$show_author $dirtable $tablepadding $columnHeaderColorDefault
$columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite
@@ -75,17 +74,15 @@ 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 $preformat_in_markup $v
+ $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 $allow_tar @tar_options @cvs_options
+ $use_moddate $has_zlib $gzip_open
$LOG_FILESEPARATOR $LOG_REVSEPARATOR
);
sub printDiffSelect($);
-sub printDiffLinks($$);
-sub printLogSortSelect($);
sub findLastModifiedSubdirs(@);
sub htmlify_sub(&$);
sub htmlify($;$);
@@ -122,7 +119,6 @@ sub toggleQuery($$);
sub urlencode($);
sub htmlquote($);
sub htmlunquote($);
-sub hrefquote($);
sub http_header(;$);
sub html_header($);
sub html_footer();
@@ -170,49 +166,6 @@ $tabstop = $use_moddate = $moddate = $gzip_open = unde
$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;
@@ -229,10 +182,9 @@ $verbose = $v;
$checkoutMagic = "~checkout~";
$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';
$where = $pathinfo;
-$where =~ tr|/|/|s;
$doCheckout = ($where =~ /^\/$checkoutMagic/);
$where =~ s|^/($checkoutMagic)?||;
-$where =~ s|/$||;
+$where =~ s|/+$||;
$scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';
$scriptname =~ s|^/?|/|;
$scriptname =~ s|/+$||;
@@ -246,7 +198,7 @@ $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} || '';
+$Browser = $ENV{HTTP_USER_AGENT};
$is_links = ($Browser =~ m`^Links `);
$is_lynx = ($Browser =~ m`^Lynx/`i);
$is_w3m = ($Browser =~ m`^w3m/`i);
@@ -279,7 +231,7 @@ $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING})
@stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag);
if (-f $config) {
- require $config
+ do $config
|| &fatal("500 Internal Error",
sprintf('Error in loading configuration file: %s %s ',
$config, &htmlify($@)));
@@ -296,7 +248,6 @@ $query = $ENV{QUERY_STRING};
if (defined($query) && $query ne '') {
foreach (split(/&/, $query)) {
- y/+/ /;
s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted
if (/(\S+)=(.*)/) {
$input{$1} = $2 if ($2 ne "");
@@ -378,7 +329,7 @@ else {
$byfile = 1;
}
-$defaultDiffType = $input{'f'};
+$hr_default = ($input{'f'} eq 'h' || $input{'f'} eq 'H');
$logsort = $input{'logsort'};
@@ -407,7 +358,7 @@ foreach $k (keys %ICONS) {
my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}};
if ($ipath) {
${"${k}icon"} = sprintf(' ',
- hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight)
+ htmlquote($ipath), htmlquote($itxt), $iwidth, $iheight)
}
else {
${"${k}icon"} = $itxt;
@@ -419,18 +370,17 @@ my $config_cvstree = "$config-$cvstree";
# Do some special configuration for cvstrees
if (-f $config_cvstree) {
- require $config_cvstree
+ do $config_cvstree
|| &fatal("500 Internal Error",
sprintf('Error in loading configuration file: %s %s ',
$config_cvstree, &htmlify($@)));
}
undef $config_cvstree;
-$re_prcategories = '(?:' . join('|', @prcategories) . ')' if @prcategories;
-$re_prkeyword = quotemeta($prkeyword) if defined($prkeyword);
+$prcategories = '(?:' . join('|', @prcategories) . ')';
$prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/;
-$fullname = "$cvsroot/$where";
+$fullname = $cvsroot . '/' . $where;
$mimetype = &getMimeTypeFromSuffix ($fullname);
$defaultTextPlain = ($mimetype eq "text/plain");
$defaultViewable = $allow_markup && viewable($mimetype);
@@ -475,68 +425,10 @@ $module = $1;
if ($module && &forbidden_module($module)) {
&fatal("403 Forbidden", "Access to $where forbidden.");
}
-
-#
-# Handle tarball downloads before any headers are output.
-#
-if ($input{tarball}) {
- &fatal("403 Forbidden", "Downloading tarballs is prohibited.")
- unless $allow_tar;
- $where =~ s,/[^/]*$,,;
- $where =~ s,^/,,;
- my($basedir) = ($where =~ m,([^/]+)$,);
-
- if ($basedir eq '' || $where eq '') {
- &fatal("500 Internal Error", "You cannot download the top level directory.");
- }
-
- my $tmpdir = "/tmp/.cvsweb.$$." . int(time);
-
- mkdir($tmpdir, 0700)
- or &fatal("500 Internal Error", "Unable to make temporary directory: $!");
-
- my $fatal = '';
-
- do {
- chdir $tmpdir
- or $fatal = "500 Internal Error", "Unable to cd to temporary directory: $!"
- && last;
-
- my $tag = (exists $input{only_with_tag} && length $input{only_with_tag})
- ? $input{only_with_tag} : "HEAD";
-
- system "cvs", @cvs_options, "-Qd", $cvsroot, "export", "-r", $tag, $where
- and $fatal = "500 Internal Error","cvs co failure: $!: $where"
- && last;
-
- chdir "$where/.."
- or $fatal = "500 Internal Error","Cannot find expected directory in checkout"
- && last;
-
- $| = 1; # Essential to get the buffering right.
-
- print "Content-type: application/x-gzip\r\n\r\n";
-
- system "tar", "-zcf", "-", $basedir, @tar_options
- and $fatal = "500 Internal Error","tar zc failure: $!: $basedir"
- && last;
-
- chdir $tmpdir
- or $fatal = "500 Internal Error","Unable to cd to temporary directory: $!"
- && last;
- } while (0);
-
- system "rm", "-rf", $tmpdir if -d $tmpdir;
-
- &fatal($fatal) if $fatal;
-
- exit;
-}
-
##############################
# View a directory
###############################
-if (-d $fullname) {
+elsif (-d $fullname) {
my $dh = do {local(*DH);};
opendir($dh, $fullname) || &fatal("404 Not Found","$where: $!");
my @dir = readdir($dh);
@@ -874,22 +766,6 @@ if (-d $fullname) {
print " \n";
print "\n";
}
-
- if ($allow_tar) {
- my($basefile) = ($where =~ m,(?:.*/)?([^/]+),);
-
- if ($basefile ne '') {
- print "
\n",
- "",
- &link("Download this directory in tarball",
- # Mangle the filename so browsers show a reasonable
- # filename to download.
- "$basefile.tar.gz$query".
- ($query ? "&" : "?")."tarball=1"),
- "
";
- }
- }
-
my $formwhere = $scriptwhere;
$formwhere =~ s|Attic/?$|| if ($input{'hideattic'});
@@ -909,9 +785,12 @@ if (-d $fullname) {
print "Revision";
print " Log message";
print "";
- print "Sort log by: ";
- printLogSortSelect(0);
- print " ";
+ print "revisions by: \n";
+ print "\n";
+ print "Not sorted";
+ print " Commit date";
+ print " Revision";
+ print " ";
print "Diff format: ";
printDiffSelect(0);
print " ";
@@ -987,13 +866,13 @@ if (-d $fullname) {
my $fh = do {local(*FH);};
my ($xtra, $module);
# Assume it's a module name with a potential path following it.
- $xtra = (($module = $where) =~ s|/.*||) ? $& : '';
+ $xtra = $& if (($module = $where) =~ s|/.*||);
# Is there an indexed version of modules?
if (open($fh, "$cvsroot/CVSROOT/modules")) {
while (<$fh>) {
if (/^(\S+)\s+(\S+)/o && $module eq $1
- && -d "$cvsroot/$2" && $module ne $2) {
- &redirect("$scriptname/$2$xtra");
+ && -d "${cvsroot}/$2" && $module ne $2) {
+ &redirect($scriptname . '/' . $2 . $xtra);
}
}
}
@@ -1005,43 +884,18 @@ gzipclose();
sub printDiffSelect($) {
my ($use_java_script) = @_;
- my $f = $input{'f'};
-
- print '';
-
- local $_;
- for (@DIFFTYPES) {
- printf('%s',
- $_,
- $f eq $_ ? ' SELECTED' : '',
- "\u$DIFFTYPES{$_}{'descr'}"
- );
- }
-
+ my ($f) = $input{'f'};
+ print "\n";
+ print "Colored Diff";
+ print " Long Colored Diff";
+ print " Unidiff";
+ print " Context Diff";
+ print " Side by Side";
print " ";
}
-sub printLogSortSelect($) {
- my ($use_java_script) = @_;
-
- print '';
-
- local $_;
- for (@LOGSORTKEYS) {
- printf('%s',
- $_,
- $logsort eq $_ ? ' SELECTED' : '',
- "\u$LOGSORTKEYS{$_}{'descr'}"
- );
- }
-
- print " ";
-}
-
sub findLastModifiedSubdirs(@) {
my (@dirs) = @_;
my ($dirname, @files);
@@ -1079,13 +933,12 @@ sub findLastModifiedSubdirs(@) {
sub htmlify_sub(&$) {
(my $proc, local $_) = @_;
local @_ = split(m`(]+>[^<]* )`i);
- my $linked;
- my $result = '';
+ my ($linked, $result);
while (($_, $linked) = splice(@_, 0, 2)) {
&$proc();
- $result .= $_ if defined($_);
- $result .= $linked if defined($linked);
+ $result .= $_;
+ $result .= $linked;
}
$result;
@@ -1114,7 +967,7 @@ sub htmlify($;$) {
if ($extra) {
# get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn"
- if (defined($prcgi) && defined($re_prcategories) && defined($re_prkeyword)) {
+ if (defined($prcgi)) {
my $prev;
do {
@@ -1122,7 +975,7 @@ sub htmlify($;$) {
$_ = htmlify_sub {
s{
- (\b$re_prkeyword[:\#]?\s*
+ (\bPR[:\#]?\s*
(?:
\#?
\d+[,\s]\s*
@@ -1130,16 +983,16 @@ sub htmlify($;$) {
\#?)
(\d+)\b
}{
- $1 . &link($2, sprintf($prcgi, $2))
+ $1 . &link($2, sprintf($prcgi, $2)) . $3
}egix;
} $_;
} while ($_ ne $prev);
$_ = htmlify_sub {
s{
- (\b$re_prcategories/(\d+)\b)
+ (\b$prcategories/(\d+)\b)
}{
- &link($1, sprintf($prcgi, $2))
+ &link($1, sprintf($prcgi, $2)) . $3
}egox;
} $_;
}
@@ -1148,7 +1001,7 @@ sub htmlify($;$) {
if (defined($mancgi)) {
$_ = htmlify_sub {
s{
- (\b([a-zA-Z][\w.]+)
+ (\b([a-zA-Z][\w_.]+)
(?:
\( ([0-9n]) \)\B
|
@@ -1156,7 +1009,7 @@ sub htmlify($;$) {
)
)
}{
- &link($1, sprintf($mancgi, defined($3) ? $3 : $4, $2))
+ &link($1, sprintf($mancgi, $3 ne '' ? $3 : $4, $2)) . $5
}egx;
} $_;
}
@@ -1198,7 +1051,7 @@ sub spacedHtmlText($;$) {
sub link($$) {
my($name, $where) = @_;
- sprintf '%s ', hrefquote($where), $name;
+ sprintf '%s ', htmlquote($where), $name;
}
sub revcmp($$) {
@@ -1372,7 +1225,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 @cvs_options -l server") || fatal ("500 Internal Error",
+ $pid = open2($reader, $writer, "cvs -Rl 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:
@@ -1565,13 +1418,8 @@ sub doCheckout($$) {
# Safely for a child process to read from.
if (! open($fh, "-|")) { # child
open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
- exec("cvs", @cvs_options, "-d", $cvsroot, "co", "-p", $revopt, $where);
+ exec("cvs", "-Rld", $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
@@ -1591,7 +1439,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;
@@ -1642,12 +1495,12 @@ sub cvswebMarkup($$$) {
my $url = download_url($fileurl, $revision, $mimetype);
print "
";
if ($mimetype =~ /^image/) {
- printf ' ', hrefquote("$url$barequery");
+ printf ' ', htmlquote("$url$barequery");
}
elsif ($mimetype =~ m%^application/pdf%) {
- printf ' ', hrefquote("$url$barequery");
+ printf ' ', htmlquote("$url$barequery");
}
- elsif ($preformat_in_markup) {
+ else {
print "";
# prefetch several lines
@@ -1662,9 +1515,6 @@ sub cvswebMarkup($$$) {
}
print " ";
}
- else {
- print "\n", <$filehandle>;
- }
}
sub viewable($) {
@@ -1679,7 +1529,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;
@@ -1713,18 +1563,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' if $f =~ /^[cHhu]$/;
my($re1, $re2);
@@ -1826,7 +1694,7 @@ sub getDirLogs($$@) {
return;
}
- if (defined($tag)) {
+ if ($tag) {
#can't use -r as - is allowed in tagnames, but misinterpreated by rlog..
if (! open($fh, "-|")) {
open(STDERR, '>/dev/null'); # rlog may complain; ignore.
@@ -1844,13 +1712,14 @@ sub getDirLogs($$@) {
while (<$fh>) {
if ($state eq "start") {
#Next file. Initialize file variables
- $rev = '';
- $revwanted = '';
- $branch = '';
- $branchpoint = '';
- $filename = '';
- $log = '';
- $revision = '';
+ $rev = undef;
+ $revwanted = undef;
+ $branch = undef;
+ $branchpoint = undef;
+ $filename = undef;
+ $log = undef;
+ $revision = undef;
+ $branch = undef;
%symrev = ();
@filetags = ();
#jump to head state
@@ -1860,74 +1729,71 @@ 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 $branch eq '';
- $branch =~ s/(\d+)$/0.$1/;
- $symrev{MAIN} = $branch;
- $symrev{HEAD} = $branch;
- $alltags{MAIN} = 1;
- $alltags{HEAD} = 1;
- push (@filetags, "MAIN", "HEAD");
- } elsif (/$LOG_REVSEPARATOR/o) {
- $state = "log";
- $rev = '';
- $date = '';
- $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/\b0\.//;
- ($branchpoint = $branch) =~ s/\.?\d+$//;
- $revwanted = '' if ($revwanted ne $branch);
- } 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" && /$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/%%;
+ next;
+ }
if ($state eq "log") {
if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) {
# End of a log entry.
- my $revbranch = $rev;
- $revbranch =~ s/\.\d+$//;
+ my $revbranch;
+ ($revbranch = $rev) =~ s/\.\d+$//;
print "$filename $rev Wanted: $revwanted ",
"Revbranch: $revbranch Branch: $branch ",
"Branchpoint: $branchpoint\n" if ($verbose);
- if ($revwanted eq '' && $branch ne ''
+ if (!defined($revwanted) && defined($branch)
&& $branch eq $revbranch || !defined($tag)) {
print "File revision $rev found for branch $branch\n"
if ($verbose);
$revwanted = $rev;
}
- if ($revwanted ne '' ? $rev eq $revwanted :
- $branchpoint ne '' ? $rev eq $branchpoint :
+ if (defined($revwanted) ? $rev eq $revwanted :
+ defined($branchpoint) ? $rev eq $branchpoint :
0 && ($rev eq $head)) { # Don't think head is needed here..
print "File info $rev found for $filename\n" if ($verbose);
my @finfo = ($rev,$date,$log,$author,$filename);
@@ -1936,11 +1802,11 @@ again:
$fileinfo{$name} = [ @finfo ];
$state = "done" if ($rev eq $revwanted);
}
- $rev = '';
- $date = '';
- $log = '';
+ $rev = undef;
+ $date = undef;
+ $log = "";
}
- elsif ($date eq '' && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) {
+ elsif (!defined($date) && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) {
my $yr = $1;
# damn 2-digit year routines :-)
if ($yr > 100) {
@@ -1952,7 +1818,7 @@ again:
$log = '';
next;
}
- elsif ($rev eq '' && /^revision (.*)$/) {
+ elsif (!defined($rev) && m/^revision (.*)$/) {
$rev = $1;
next;
}
@@ -2094,11 +1960,12 @@ sub readLog($;$) {
# is the first commit listed on the appropriate branch.
# This is not neccesary the same revision as marked as head in the RCS file.
my $headrev = $curbranch || "1";
- ($symrev{"MAIN"} = $headrev) =~ s/(\d+)$/0.$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+$//
@@ -2129,7 +1996,6 @@ 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)
#
@@ -2137,13 +2003,14 @@ sub readLog($;$) {
$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 "");
@@ -2199,20 +2066,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) = @_;
@@ -2337,7 +2190,10 @@ sub printLog($;$) {
$barequery);
print " to previous ";
- printDiffLinks($prev, $url);
+ print &link($prev, $url);
+ if (!$hr_default) { # offer a human readable version if not default
+ print ' (', &link('colored', "$url&f=h"), ')';
+ }
}
#
# Plus, if it's on a branch, and it's not a vendor branch,
@@ -2350,7 +2206,10 @@ sub printLog($;$) {
$barequery);
print " to branchpoint ";
- printDiffLinks($brp, $url);
+ print &link($brp, $url);
+ if (!$hr_default) { # offer a human readable version if not default
+ print ' (', &link('colored', "$url&f=h"), ')';
+ }
}
#
# Plus, if it's on a branch, and it's not a vendor branch,
@@ -2360,18 +2219,18 @@ sub printLog($;$) {
if (/^\d+\.\d+\.\d+/ && !/^1\.1\.1\.\d+$/) {
my ($i,$nextmain);
for ($i = 0; $i < $#revorder && $revorder[$i] ne $_; $i++){}
- my @tmp2 = split(/\./, $_);
+ my (@tmp2) = split(/\./, $_);
for ($nextmain = ""; $i > 0; $i--) {
- my $next = $revorder[$i-1];
- my @tmp1 = split(/\./, $next);
- if (@tmp1 < @tmp2) {
+ my ($next) = $revorder[$i-1];
+ my (@tmp1) = split(/\./, $next);
+ if ($#tmp1 < $#tmp2) {
$nextmain = $next;
last;
}
# Only the highest version on a branch should have
# a diff for the "next main".
- last if (@tmp1 - 1 <= @tmp2 &&
- join(".",@tmp1[0..$#tmp1-1]) eq join(".",@tmp2[0..$#tmp1-1]));
+ last if (join(".",@tmp1[0..$#tmp1-1])
+ eq join(".",@tmp2[0..$#tmp1-1]));
}
if (!defined($diffrev{$nextmain})) {
$diffrev{$nextmain} = 1;
@@ -2383,7 +2242,10 @@ sub printLog($;$) {
$barequery);
print " next main ";
- printDiffLinks($nextmain, $url);
+ print &link($nextmain, $url);
+ if (!$hr_default) { # offer a human readable version if not default
+ print ' (', &link('colored', "$url&f=h"), ')';
+ }
}
}
# Plus if user has selected only r1, then present a link
@@ -2398,7 +2260,10 @@ sub printLog($;$) {
$barequery);
print " to selected ";
- printDiffLinks($input{'r1'}, $url);
+ print &link($input{'r1'}, $url);
+ if (!$hr_default) { # offer a human readable version if not default
+ print ' (', &link('colored', "$url&f=h"), ')';
+ }
}
}
print "\n";
@@ -2478,8 +2343,8 @@ sub doLog($) {
print " \n";
print " ";
@@ -2718,10 +2587,9 @@ sub navigateHeader($$$$$) {
my ($swhere,$path,$filename,$rev,$title) = @_;
$swhere = "" if ($swhere eq $scriptwhere);
$swhere = urlencode($filename) if ($swhere eq "");
- print qq``;
+ print "<\!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">";
print "\n\n";
- print qq` \n`;
- print '';
+ print '';
print "\n$path$filename - $title - $rev \n";
print "$body_tag_for_src\n";
print "";
@@ -2944,7 +2812,7 @@ sub download_link($$$;$) {
my ($url, $revision, $textlink, $mimetype) = @_;
my ($fullurl) = download_url($url, $revision, $mimetype);
- printf '$textlink ";
@@ -3018,7 +2886,8 @@ sub urlencode($) {
s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge;
- $_;
+
+ $_;
}
sub htmlquote($) {
@@ -3045,20 +2914,8 @@ sub htmlunquote($) {
$_;
}
-sub hrefquote($) {
- local($_) = @_;
-
- y/ /+/;
-
- htmlquote($_)
-}
-
sub http_header(;$) {
my $content_type = shift || "text/html";
-
- $content_type .= "; charset=$charset"
- if $content_type =~ m,^text/, && defined($charset) && $charset;
-
if (defined($moddate)) {
if ($is_mod_perl) {
Apache->request->header_out("Last-Modified" => scalar gmtime($moddate) . " GMT");
@@ -3091,7 +2948,7 @@ sub http_header(;$) {
}
select(GZIP);
$gzip_open = 1;
-# print "" if ($content_type =~ m|^text/html\b|);
+# print "" if ($content_type eq "text/html");
}
else {
if ($is_mod_perl) {
@@ -3115,14 +2972,12 @@ sub http_header(;$) {
sub html_header($) {
my ($title) = @_;
- my $version = '$zRevision: 1.104 $ $kRevision: 1.54 $'; #'
- http_header("text/html");
+ my $version = '$zRevision: 1.103 $ $Revision: 3.36 $'; #'
+ http_header();
print <
-
-
$title