===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1.1.37
retrieving revision 1.6
diff -u -p -r1.1.1.37 -r1.6
--- cvsweb/cvsweb.cgi 2007/03/17 21:52:33 1.1.1.37
+++ cvsweb/cvsweb.cgi 1997/04/30 07:35:11 1.6
@@ -1,4522 +1,536 @@
-#!/usr/bin/perl -T
+#!/usr/bin/perl -s
#
-# cvsweb - a CGI interface to CVS trees.
+# cvsweb - a CGI interface to the CVS tree.
#
-# Written in their spare time by
-# Bill Fenner
+Please send any suggestions, comments, etc. to
+Bill Fenner <fenner@freebsd.org>
+";
+$shortinstr = "
+Click on a directory to enter that directory. Click on a file to display
+its revision history and to get a
+chance to display diffs between revisions.
+";
-use warnings;
-use filetest qw(access);
+$verbose = $v;
+($where = $ENV{'PATH_INFO'}) =~ s|^/||;
+$where =~ s|/$||;
+$fullname = $cvsroot . '/' . $where;
+($scriptname = $ENV{'SCRIPT_NAME'}) =~ s|^/?|/|;
+$scriptname =~ s|/$||;
+$scriptwhere = $scriptname . '/' . $where;
+$scriptwhere =~ s|/$||;
-use vars qw (
- $VERSION $CheckoutMagic $MimeTypes $DEBUG
- $config $allow_version_select
- @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr
- %MIRRORS %DEFAULTVALUE %ICONS %MTYPES
- %DIFF_COMMANDS @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS
- %alltags %fileinfo %tags @branchnames %nameprinted
- %symrev %revsym @allrevisions %date %author @revdisplayorder
- @revisions %state %difflines %log %branchpoint @revorder $keywordsubstitution
- $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi
- $doCheckout $scriptname $scriptwhere
- $where $Browser $nofilelinks $maycompress @stickyvars %funcline_regexp
- $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
- $charset $output_filter
- @command_path %CMD $allow_compress $backicon $diricon $fileicon $graphicon
- $fullname $cvstreedefault $logo $defaulttitle $address $binfileicon
- $long_intro $short_instruction $shortLogLen $show_author
- $tablepadding $hr_breakable $showfunc $hr_ignwhite $hr_ignkeysubst
- $inputTextSize $mime_types $allow_annotate $allow_markup $allow_mailtos
- $allow_log_extra $allow_dir_extra $allow_source_extra
- $allow_cvsgraph $cvsgraph_config $use_java_script $edit_option_form
- $show_subdir_lastmod $show_log_in_markup $preformat_in_markup
- $tabstop $state $annTable $sel @ForbiddenFiles
- $use_descriptions %descriptions @mytz $dwhere
- $use_moddate $gzip_open $file_list_len
- $allow_tar @tar_options @gzip_options @zip_options @cvs_options
- @annotate_options @rcsdiff_options
- $HTML_DOCTYPE $HTML_META $cssurl $CSS $cvshistory_url
- $allow_enscript @enscript_options %enscript_types
-);
-
-use Cwd qw(abs_path);
-use File::Basename qw(dirname);
-use File::Path qw(rmtree);
-use File::Spec::Functions qw(canonpath catdir catfile curdir devnull rootdir
- tmpdir updir);
-use File::Temp qw(tempdir tempfile);
-use IPC::Run qw();
-use Time::Local qw(timegm);
-use URI::Escape qw(uri_escape uri_unescape);
-
-use constant VALID_PATH => qr/^([[:^cntrl:]]+)$/o;
-use constant VALID_TAG1 => qr/^([a-zA-Z][[:graph:]]*)$/o;
-use constant VALID_TAG2 => qr/^([^\$,.:;@]+)$/o;
-use constant CVSWEBMARKUP => qr{^text/(x-cvsweb|vnd\.viewcvs)-markup$}io;
-use constant LOG_FILESEPR => qr/^={77}$/o;
-use constant LOG_REVSEPR => qr/^-{28}$/o;
-
-use constant HAS_ZLIB => eval { require Compress::Zlib; };
-use constant HAS_EDIFF => eval { require String::Ediff; };
-
-# -----------------------------------------------------------------------------
-
-# All global initialization that can be done in compile time should go to
-# the BEGIN block. Persistent environments, such as mod_perl, will benefit
-# from this.
-
-BEGIN
-{
- $VERSION = '3.0.6';
-
- $HTML_DOCTYPE =
- '';
-
- $HTML_META = < The server on which the CVS tree lives is probably down. Please try again in a few minutes.');
+ &fatal("500 Internal Error",'$CVSROOT not found!');
}
-
-#
-# Short-circuit forbidden things. Note that $fullname should not change
-# after this, because the rest of the code assumes this check has already
-# been done.
-#
-fatal('403 Forbidden', 'Access to %s forbidden.', $where)
- if forbidden($fullname);
-
-#
-# Handle tarball downloads before any headers are output.
-#
-if ($input{tarball}) {
- fatal('403 Forbidden', 'Downloading tarballs is prohibited.')
- unless $allow_tar;
-
- my ($module) = ($where =~ m,^/?(.*),); # untaint
- $module =~ s,/([^/]*)$,,;
- my ($ext) = ($1 =~ /(\.t(?:ar\.)?gz|\.zip)$/);
- my ($basedir) = ($module =~ m,([^/]+)$,);
-
- if ($basedir eq '' || $module eq '') {
- fatal('500 Internal Error',
- 'You cannot download the top level directory.');
- }
-
- my $istar = ($ext eq '.tar.gz' || $ext eq '.tgz');
- if ($istar) {
- fatal('500 Internal Error', 'tar command not found.') unless $CMD{tar};
- fatal('500 Internal Error', 'gzip command not found.') unless $CMD{gzip};
- }
- my $iszip = ($ext eq '.zip');
- if ($iszip && !$CMD{zip}) {
- fatal('500 Internal Error', 'zip command not found.');
- }
- if (!$istar && !$iszip) {
- fatal('500 Internal Error', 'Unsupported archive type.');
- }
-
- my $tmpexportdir;
- eval {
- local $SIG{__DIE__};
- # Don't use the CLEANUP argument to tempdir() here, since we might be under
- # mod_perl (the process runs for a long time), unlink explicitly later.
- $tmpexportdir = tempdir('.cvsweb.XXXXXXXX', TMPDIR => 1);
- };
- if ($@) {
- fatal('500 Internal Error', 'Unable to make temporary directory: %s', $@);
- }
- if (!chdir($tmpexportdir)) {
- fatal('500 Internal Error',
- "Can't cd to temporary directory %s: %s", $tmpexportdir, $!);
- }
-
- my @fatal;
- my $tag = $input{only_with_tag} || 'HEAD';
- $tag = 'HEAD' if ($tag eq 'MAIN');
-
- my @cmd =
- ($CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag,
- '-d', $basedir, $module);
- my $export_err;
- my ($errcode, $err) = runproc(\@cmd, '2>', \$export_err);
- if ($errcode) {
- @fatal =
- ('500 Internal Error',
- 'Export failure (exit status %s), output: \n";
- while ( Current directory: ', clickablePath($where, 0), '';
- if ($cvshistory_url) {
- (my $d = $where) =~ s|^/*(.*?)/*$|$1|;
- print ' - ', history_link($d, '');
- }
- print " Current tag: ", htmlquote($input{only_with_tag}), "%s
',
- $ENV{PATH_INFO});
-}
-if ($ENV{SCRIPT_NAME}) {
- ($scriptname) = ($ENV{SCRIPT_NAME} =~ VALID_PATH)
- or fatal('500 Internal Error',
- 'Illegal SCRIPT_NAME in environment: %s
',
- $ENV{SCRIPT_NAME});
-}
-
-$scriptname = '' unless defined($scriptname);
-
-$where = $pathinfo;
-$doCheckout = $where =~ s|^/$CheckoutMagic/|/|o;
-$where =~ s|^/||;
-$scriptname =~ s|^/*|/|;
-
-# Let's workaround thttpd's stupidity..
-if ($scriptname =~ m|/$|) {
- $pathinfo .= '/';
- my $re = quotemeta $pathinfo;
- $scriptname =~ s/$re$//;
-}
-
-# $scriptname : the URI escaped path to this script
-# $where : the path in the CVS repository (without leading /, or only /)
-# $scriptwhere: the URI escaped $scriptname + '/' + $where
-$scriptname = uri_escape_path($scriptname);
-$scriptwhere = join('/', $scriptname, uri_escape_path($where));
-$where = '/' if ($where eq '');
-
-# In text-based browsers, it's very annoying to have two links per file;
-# skip linking the image for them.
-
-$Browser = $ENV{HTTP_USER_AGENT} || '';
-$is_links = ($Browser =~ m`^E?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);
-
-$nofilelinks = $is_textbased;
-
-# newer browsers accept gzip content encoding
-# and state this in a header
-# (netscape did always but didn't state it)
-# It has been reported that these
-# 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} =~ /gzip/)
- || $is_mozilla3)
- && !$is_msie
- && !(defined($ENV{MOD_PERL}) && !HAS_ZLIB)
-);
-
-# Parameters that will be sticky in all constructed links/query strings.
-@stickyvars =
- qw(cvsroot hideattic ignorecase sortby logsort f only_with_tag ln
- hidecvsroot hidenonreadable);
-
-#
-# Load configuration.
-#
-if (-f $config) {
- do "$config" or config_error($config, $@);
-} else {
- fatal("500 Internal Error",
- 'Configuration not found. Set the parameter $config
in cvsweb.cgi to your cvsweb.conf configuration file first.');
-}
-
-# Try to find a readable dir where we can cd into. Some abs_path()
-# implementations as well as various cvs operations require such a dir to
-# work properly.
-{
- local $^W = 0;
- for my $dir (tmpdir(), rootdir()) {
- last if (-r $dir && chdir($dir));
- }
-}
-
-$CSS = $cssurl ?
- sprintf("\n",
- htmlquote($cssurl)) : '';
-
-# --- input parameters
-
-my %query = ();
-if (defined($ENV{QUERY_STRING})) {
- for my $p (split(/[;&]+/, $ENV{QUERY_STRING})) {
- next unless $p;
- $p =~ y/+/ /;
- my ($key, $val) = split(/=/, $p, 2);
- next unless defined($key);
- $val = 1 unless defined($val);
- ($key = uri_unescape($key)) =~ /[[:graph:]]/ or next;
- ($val = uri_unescape($val)) =~ /[[:graph:]]/ or next;
- $query{$key} = $val;
- }
-}
-
-undef %input;
-
-my $t;
-for my $p (qw(graph hideattic hidecvsroot hidenonreadable ignorecase ln copt
- makeimage options tarball)) {
- $t = $query{$p};
- if (defined($t)) {
- ($input{$p}) = ($t =~ /^([01]|on)$/)
- or fatal('500 Internal Error',
- 'Invalid boolean value: %s=%s
', $p, $t);
- }
-}
-for my $p (qw(annotate r1 r2 rev tr1 tr2)) {
- $t = $query{$p};
- if (defined($t)) {
- if (($p eq 'r1' || $p eq 'r2') && $t eq 'text') {
- # Special case for the "Use text field" option in the log view diff form.
- $input{$p} = $t;
- next;
- } elsif (($p eq 'rev' || $p eq 'annotate') && ($t eq '.' || $t eq 'HEAD')){
- # Another special case, allow linking to latest revision using these.
- $input{$p} = '.';
- next;
- }
- my ($rev, $tag) = split(/:/, $t, 2);
- ($input{$p}) = ($rev =~ /^(\d+(?:\.\d+)*)$/)
- or fatal('500 Internal Error',
- 'Invalid revision: %s=%s
', $p, $t);
- if (defined($tag)) {
- ($tag) = ($tag =~ VALID_TAG1)
- or fatal('500 Internal Error',
- 'Invalid tag/branch name in revision: %s=%s
',
- $p, $t);
- ($tag) = ($tag =~ VALID_TAG2)
- or fatal('500 Internal Error',
- 'Invalid tag/branch name in revision: %s=%s
',
- $p, $t);
- $input{$p} .= ':' . $tag;
- }
- }
-}
-$t = defined($query{only_with_tag}) ?
- $query{only_with_tag} : $query{only_on_branch}; # Backwards compatibility.
-if (defined($t)) {
- ($input{only_with_tag}) = ($t =~ VALID_TAG1)
- or fatal('500 Internal Error',
- 'Invalid tag/branch name: %s
', $t);
- ($input{only_with_tag}) = ($t =~ VALID_TAG2)
- or fatal('500 Internal Error',
- 'Invalid tag/branch name: %s
', $t);
-}
-$t = $query{logsort};
-if (defined($t)) {
- ($input{logsort}) = ($t =~ /^(cvs|date|rev)$/)
- or fatal('500 Internal Error',
- 'Unsupported log sort key: %s
', $t);
-}
-$t = $query{f};
-if (defined($t)) {
- ($input{f}) = ($t =~ /^(([hH]|[ucs]c?)|ext\d*)$/)
- or fatal('500 Internal Error',
- 'Unsupported diff format: %s
', $t);
-}
-$t = $query{sortby};
-if (defined($t)) {
- ($input{sortby}) = ($t =~ /^(file|date|rev|author|log)$/)
- or fatal('500 Internal Error',
- 'Unsupported dir sort key: %s
', $t);
-}
-$t = $query{'content-type'};
-if (defined($t)) {
- ($input{'content-type'}) = ($t =~ m|^([-0-9A-Za-z]+/[-0-9A-Za-z\.\+]+)$|)
- or fatal('500 Internal Error',
- 'Unsupported content type: %s
', $t);
-}
-$t = $query{cvsroot};
-if (defined($t)) {
- ($input{cvsroot}) = ($t =~ /^([[:print:]]+)$/)
- or fatal('500 Internal Error',
- 'Invalid symbolic CVS root name: %s
', $t);
-}
-$t = $query{path};
-if (defined($t)) {
- ($input{path}) = ($t =~ VALID_PATH)
- or fatal('500 Internal Error',
- 'Invalid path: %s
', $t);
-}
-undef($t);
-undef(%query);
-
-# --- end input parameters
-
-#
-# CVS roots
-#
-my $rootfound = 0;
-for (my $i = 0; $i < scalar(@CVSrepositories); $i += 2) {
- my $key = $CVSrepositories[$i];
- my ($descr, $root) = @{$CVSrepositories[$i+1]};
- $root = canonpath($root);
- unless (-d $root) {
- warn("Root '$root' defined in \@CVSrepositories is not a directory, " .
- 'entry ignored');
- next;
- }
- $rootfound ||= 1;
- $cvstreedefault = $key unless defined($cvstreedefault);
- $CVSROOTdescr{$key} = $descr;
- $CVSROOT{$key} = $root;
- push(@CVSROOT, $key);
-}
-unless ($rootfound) {
- fatal('500 Internal Error',
- 'No valid CVS roots found! See @CVSrepositories
in ' .
- 'the configuration file (%s
).',
- $config);
-}
-undef $rootfound;
-
-#
-# Default CVS root
-#
-if (!defined($CVSROOT{$cvstreedefault})) {
- fatal("500 Internal Error",
- '$cvstreedefault
points to a repository (%s) not ' .
- 'defined in @CVSrepositories
in your configuration ' .
- 'file (%s
).',
- $cvstreedefault,
- $config);
-}
-
-$DEFAULTVALUE{cvsroot} = $cvstreedefault;
-
-while (my ($key, $defval) = each %DEFAULTVALUE) {
-
- # Replace not given parameters with defaults.
- next unless (defined($defval) && $defval =~ /\S/ && !defined($input{$key}));
-
- # Empty checkboxes in forms return nothing, so we define a helper parameter
- # in these forms (copt) which indicates that we just set parameters with a
- # checkbox.
- if ($input{copt}) {
-
- # 'copt' is set -> the result of empty input checkbox
- # -> set to zero (disable) if default is a boolean (0|1).
- $input{$key} = 0 if ($defval eq '0' || $defval eq '1');
-
- } else {
-
- # 'copt' isn't set --> empty input is not the result
- # of empty input checkbox --> set default.
- $input{$key} = $defval;
- }
-}
-
-$barequery = "";
-my @barequery;
-foreach (@stickyvars) {
-
- # construct a query string with the sticky non default parameters set
- if (defined($input{$_})
- && !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_}))
- {
- push(@barequery, join('=', uri_escape($_), uri_escape($input{$_})));
- }
-}
-
-if ($allow_enscript) {
- push(@DIFFTYPES, qw(uc cc sc));
- @DIFFTYPES{qw(uc cc sc)} = (
- {
- 'descr' => 'unified, colored',
- 'opts' => ['-u'],
- 'colored' => 0,
- },
- {
- 'descr' => 'context, colored',
- 'opts' => ['-c'],
- 'colored' => 0,
- },
- {
- 'descr' => 'side by side, colored',
- # width=168 should be enough to support 80 character line lengths
- 'opts' => ['--side-by-side', '--width=168'],
- 'colored' => 0,
- },
- );
-} else {
- # No Enscript -> respect difftype, but don't offer colorization.
- if ($input{f} && $input{f} =~ /^([ucs])c$/) {
- $input{f} = $1;
- }
-}
-
-# is there any query ?
-if (@barequery) {
- $barequery = join (';', @barequery);
- $query = "?$barequery";
- $barequery = ";$barequery";
-} else {
- $query = "";
-}
-undef @barequery;
-
-if (defined($input{path})) {
- redirect("$scriptname/$input{path}$query");
-}
-
-# get actual parameters
-{
- my $sortby = $input{sortby} || 'file';
- $bydate = 0;
- $byrev = 0;
- $byauthor = 0;
- $bylog = 0;
- $byfile = 0;
- if ($sortby eq 'date') {
- $bydate = 1;
- } elsif ($sortby eq 'rev') {
- $byrev = 1;
- } elsif ($sortby eq 'author') {
- $byauthor = 1;
- } elsif ($sortby eq 'log') {
- $bylog = 1;
- } else {
- $byfile = 1;
- }
-}
-
-$defaultDiffType = $input{f};
-
-$logsort = $input{logsort};
-
-# alternate CVS-Tree, configured in cvsweb.conf
-if ($input{cvsroot} && $CVSROOT{$input{cvsroot}}) {
- $cvstree = $input{cvsroot};
-} else {
- $cvstree = $cvstreedefault;
-}
-
-$cvsroot = $CVSROOT{$cvstree};
-
-# create icons out of description
-foreach my $k (keys %ICONS) {
- my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}};
- no strict 'refs';
- if ($ipath) {
- ${"${k}icon"} =
- sprintf('',
- htmlquote($ipath), htmlquote($itxt), $iwidth, $iheight);
- } else {
- ${"${k}icon"} = $itxt;
- }
-}
-
-my $config_cvstree = "$config-$cvstree";
-
-# Do some special configuration for cvstrees
-if (-f $config_cvstree) {
- do "$config_cvstree"
- or fatal("500 Internal Error",
- 'Error in loading configuration file: %s
%s
',
- $config_cvstree, $@);
-}
-undef $config_cvstree;
-
-$re_prcategories = '(?:' . join ('|', @prcategories) . ')' if @prcategories;
-$re_prkeyword = quotemeta($prkeyword) if defined($prkeyword);
-$prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/;
-
-$fullname = catfile($cvsroot, $where);
-
-my $rewrite = 0;
-if ($pathinfo =~ m|//|) {
- $pathinfo =~ y|/|/|s;
- $rewrite = 1;
-}
-if (-d $fullname) {
- if ($pathinfo !~ m|/$|) {
- $pathinfo .= '/';
- $rewrite = 1;
- }
-} elsif ($pathinfo =~ m|/$|) {
- chop $pathinfo;
- $rewrite = 1;
-}
-if ($rewrite) {
- redirect($scriptname . uri_escape_path($pathinfo) . $query, 1);
-}
-undef $rewrite;
-
-undef $pathinfo;
-
if (!-d $cvsroot) {
- fatal("500 Internal Error",
- '$CVSROOT not found!%s
',
- $errcode, $err || $export_err);
-
- } else {
-
- $| = 1; # Essential to get the buffering right.
- local (*TAR_OUT);
-
- my (@cmd, $ctype);
- if ($istar) {
- my @tar = ($CMD{tar}, @tar_options, '-cf', '-', $basedir);
- my @gzip = ($CMD{gzip}, @gzip_options, '-c');
- push(@cmd, \@tar, '|', \@gzip);
- $ctype = 'application/x-gzip';
- } elsif ($iszip) {
- my @zip = ($CMD{zip}, @zip_options, '-r', '-', $basedir);
- push(@cmd, \@zip, \'');
- $ctype = 'application/zip';
- }
- push(@cmd, '>pipe', \*TAR_OUT);
-
- my ($h, $err) = startproc(@cmd);
- if ($h) {
- print "Content-Type: $ctype\r\n\r\n";
- local $/ = undef;
- print %s
',
- $istar ? 'Tar' : 'Zip', $? >> 8 || -1, $err);
- }
- }
-
- # Clean up.
- rmtree($tmpexportdir);
-
- &fatal(@fatal) if @fatal;
-
- exit;
-}
-
-##############################
-# View a directory
-###############################
if (-d $fullname) {
-
- my $dh = do { local (*DH); };
- opendir($dh, $fullname) or fatal("404 Not Found", '%s: %s', $where, $!);
- my @dir = grep(!forbidden(catfile($fullname, $_)), readdir($dh));
- closedir($dh);
- my @subLevelFiles = findLastModifiedSubdirs(@dir) if $show_subdir_lastmod;
- my @unreadable = getDirLogs($cvsroot, $where, @subLevelFiles);
-
- if ($where eq '/') {
- html_header($defaulttitle);
- $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g;
- print $long_intro;
- } else {
- html_header($where);
- my $html = (-f catfile($fullname, 'README.cvs.html,v') ||
- -f catfile($fullname, 'Attic', 'README.cvs.html,v'));
- my $text = (!$html &&
- (-f catfile($fullname, 'README.cvs,v') ||
- -f catfile($fullname, 'Attic', 'README.cvs,v')));
- if ($html || $text) {
- my $rev = $input{only_with_tag} || 'HEAD';
- my $cr = abs_path($cvsroot) || $cvsroot;
- my $co = "$where/README.cvs.html" if $html;
- $co ||= "$where/README.cvs" if $text;
- # abs_path() taints when run as a CGI...
- if ($cr =~ VALID_PATH) {
- $cr = $1;
- } else {
- fatal('500 Internal Error', 'Illegal CVS root: %s
', $cr);
- }
- my @cmd = ($CMD{cvs}, @cvs_options, '-d', $cr, 'co', '-p', "-r$rev",$co);
- local (*CVS_OUT, *CVS_ERR);
- my ($h, $err) = startproc(\@cmd, \"", '>pipe', \*CVS_OUT,
- '2>pipe', \*CVS_ERR);
- fatal('500 Internal Error', $err) unless $h;
- if ($html) {
- local $/ = undef;
- print
';
- }
- print "
\n";
-
- my $infocols = 1;
-
- printf(<
-EOF
- printf(' \n";
-
- my $dirrow = 0;
-
- my $i;
- lookingforattic:
- for ($i = 0; $i <= $#dir; $i++) {
- if ($dir[$i] eq "Attic") {
- last lookingforattic;
- }
- }
-
- if (!$input{hideattic}
- && ($i <= $#dir)
- && opendir($dh, $fullname . '/Attic'))
- {
- splice(@dir, $i, 1, grep((s|^|Attic/|, !m|/\.|), readdir($dh)));
- closedir($dh);
- }
-
- my $hideAtticToggleLink =
- $input{hideattic}
- ? ''
- : &link('[hide]', sprintf('./%s#dirlist', &toggleQuery('hideattic')));
-
- # Sort without the Attic/ pathname.
- # place directories first
-
- my $filesexists;
- my $filesfound;
-
- foreach my $file (sort { &fileSortCmp } @dir) {
-
- next if ($file eq curdir());
-
- # ignore CVS lock and stale NFS files
- next if ($file =~ /^\#cvs\.|^,|^\.nfs/); # \# for XEmacs cperl-mode...
-
- # Check whether to show the CVSROOT path
- next if ($input{hidecvsroot} && $where eq '/' && $file eq 'CVSROOT');
-
- # Is it a directory?
- my $isdir = -d catdir($fullname, $file);
-
- # Ignore non-readable files and directories?
- next if ($input{hidenonreadable} && (! -r _ || ($isdir && ! -x _)));
-
- my $attic = '';
- if ($file =~ s|^Attic/||) {
- $attic = ' (in the Attic) ' .
- $hideAtticToggleLink . '';
- }
-
- if ($file eq updir() || $isdir) {
- next if ($file eq updir() && $where eq '/');
- my ($rev, $date, $log, $author, $filename, $keywordsubst) =
- @{$fileinfo{$file}} if (defined($fileinfo{$file}));
- printf "', ($byfile ? ' class="sorted"' : ''));
-
- if ($byfile) {
- print 'File';
- } else {
- print &link('File',
- sprintf('./%s#dirlist', toggleQuery('sortby', 'file')));
- }
- print " \n";
-
- # Do not display the other column headers if we do not have any files
- # with revision information.
- if (scalar(%fileinfo)) {
- $infocols++;
- printf('', ($byrev ? ' class="sorted"' : ''));
-
- if ($byrev) {
- print 'Rev.';
- } else {
- print &link('Rev.',
- sprintf('./%s#dirlist', toggleQuery('sortby', 'rev')));
- }
- print " \n";
- $infocols++;
- printf('', ($bydate ? ' class="sorted"' : ''));
-
- if ($bydate) {
- print 'Age';
- } else {
- print &link('Age',
- sprintf('./%s#dirlist', toggleQuery('sortby', 'date')));
- }
- print " \n";
-
- if ($show_author) {
- $infocols++;
- printf('', ($byauthor ? ' class="sorted"' : ''));
-
- if ($byauthor) {
- print 'Author';
- } else {
- print
- &link('Author',
- sprintf('./%s#dirlist', toggleQuery('sortby', 'author')));
- }
- print " \n";
- }
- $infocols++;
- printf('', ($bylog ? ' class="sorted"' : ''));
-
- if ($bylog) {
- print 'Last log entry';
- } else {
- print &link('Last log entry',
- sprintf('./%s#dirlist', toggleQuery('sortby', 'log')));
- }
- print " \n";
- } elsif ($use_descriptions) {
- print "Description \n";
- $infocols++;
- }
- print "\n \n";
- $dirrow++;
-
- } elsif ($file =~ s/,v$//) {
-
- my $fileurl = ($attic ? 'Attic/' : '') . uri_escape_path($file);
- my $url = './' . $fileurl . $query;
- $filesexists++;
- next if (!defined($fileinfo{$file}));
- my ($rev, $date, $log, $author, $filename, $keywordsubst) =
- @{$fileinfo{$file}};
- my $isbinary = $keywordsubst eq 'b' ? 1 : 0;
- $filesfound++;
-
- printf "",
- ($dirrow % 2) ? 'even' : 'odd';
-
- if ($file eq updir()) {
- my $url = "../$query";
- print $nofilelinks ? $backicon : &link($backicon, $url);
- print ' ', &link("Parent Directory", $url);
-
- } else {
- my $url = './' . uri_escape_path($file) . "/$query";
- print '';
- print $nofilelinks ? $diricon : &link($diricon, $url);
- print ' ', &link(htmlquote("$file/"), $url), $attic;
- if ($file eq "Attic") {
- print ' ',
- &link('[show]',
- sprintf('./%s#dirlist', &toggleQuery('hideattic'))),
- '';
- }
- }
-
- # Show last change in dir
- if ($filename) {
- print " \n \n";
- print readableTime(time() - $date, 0) if $date;
- print " \n", htmlquote($author)
- if $show_author;
- print " \n";
- $filename =~ s%^[^/]+/%%;
- print &link(htmlquote("$filename/$rev"),
- sprintf('%s/%s%s#rev%s',
- uri_escape($file), uri_escape($filename),
- $query, $rev)), '
';
- if ($log) {
- print htmlify(substr($log, 0, $shortLogLen), $allow_dir_extra);
- print '...' if (length($log) > 80);
- }
-
- } else {
- my $dwhere = ($where ne '/' ? $where : '') . $file;
-
- if ($use_descriptions && defined $descriptions{$dwhere}) {
- print '';
- print $descriptions{$dwhere};
-
- } elsif ($infocols > 1) {
-
- # close the row with the appropriate number of
- # columns, so that the vertical seperators are visible
- my ($cols) = $infocols;
- while ($cols > 1) {
- print " \n ";
- $cols--;
- }
- }
- }
-
- print " \n\n", ($dirrow % 2) ? 'even' : 'odd';
- printf ' ";
- $dirrow++;
- }
- print "\n";
- }
-
- print "\n";
-
- if ((my $num = scalar(@unreadable)) && ! $input{hidenonreadable}) {
- printf(<', $allow_cvsgraph ? '' : ' colspan="2"';
-
- my $icon = $isbinary ? $binfileicon : $fileicon;
- print $nofilelinks ? $icon : &link($icon, $url);
- print ' ', &link(htmlquote($file), $url), $attic;
- print ' ', graph_link($fileurl) if $allow_cvsgraph;
- print " \n", display_link($fileurl, $rev);
- print " \n";
- print readableTime(time() - $date, 0) if $date;
- print " \n", htmlquote($author) if $show_author;
- print " \n";
-
- if ($log) {
- print htmlify(substr($log, 0, $shortLogLen), $allow_dir_extra);
- print '...' if (length $log > 80);
- }
- print " \n
- %s
-
Current directory: /$where\n"; + print "