===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1
retrieving revision 1.1.1.33
diff -u -p -r1.1 -r1.1.1.33
--- cvsweb/cvsweb.cgi 1996/09/28 23:31:06 1.1
+++ cvsweb/cvsweb.cgi 2002/07/23 16:15:22 1.1.1.33
@@ -1,526 +1,3757 @@
-#!/usr/bin/perl -s
+#!/usr/bin/perl -wT
#
-# cvsweb - a CGI interface to the CVS tree.
+# cvsweb - a CGI interface to CVS trees.
#
-# Written by Bill Fenner on his own time.
-# Insert BSD copyright here.
+# Written in their spare time by
+# Bill Fenner (original work)
+# extended by Henner Zeller ,
+# Henrik Nordstrom
+# Ken Coar
+# Dick Balaska
+# Akinori MUSHA
+# Jens-Uwe Mager
+# Ville Skyttä
+# Vassilii Khachaturov
#
-#HTTP_USER_AGENT: Mozilla/1.1N (X11; I; SunOS 4.1.3_U1 sun4m) via proxy gateway CERN-HTTPD/3.0 libwww/2.17
-#SERVER_NAME: www.freebsd.org
-#QUERY_STRING: baz
-#SCRIPT_FILENAME: /usr/local/www/cgi-bin/env.pl
-#SERVER_PORT: 80
-#HTTP_ACCEPT: */*, image/gif, image/x-xbitmap, image/jpeg
-#SERVER_PROTOCOL: HTTP/1.0
-#HTTP_COOKIE: s=beta26429821397802167
-#PATH_INFO: /foo/bar
-#REMOTE_ADDR: 13.1.64.94
-#DOCUMENT_ROOT: /usr/local/www/data/
-#PATH: /sbin:/bin:/usr/sbin:/usr/bin
-#PATH_TRANSLATED: /usr/local/www/data//foo/bar
-#GATEWAY_INTERFACE: CGI/1.1
-#REQUEST_METHOD: GET
-#SCRIPT_NAME: /cgi-bin/env.pl
-#SERVER_SOFTWARE: Apache/1.0.0
-#REMOTE_HOST: beta.xerox.com
-#SERVER_ADMIN: webmaster@freebsd.org
+# Based on:
+# * Bill Fenners cvsweb.cgi revision 1.28 available from:
+# http://www.FreeBSD.org/cgi/cvsweb.cgi/www/en/cgi/cvsweb.cgi
#
-require 'timelocal.pl';
-require 'ctime.pl';
+# Copyright (c) 1996-1998 Bill Fenner
+# (c) 1998-1999 Henner Zeller
+# (c) 1999 Henrik Nordstrom
+# (c) 2000-2002 Akinori MUSHA
+# (c) 2002 Ville Skyttä
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# $FreeBSD: projects/cvsweb/cvsweb.cgi,v 1.119 2002/07/23 13:58:32 scop Exp $
+# $zId: cvsweb.cgi,v 1.112 2001/07/24 13:03:16 hzeller Exp $
+# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.84 2001/10/07 20:50:10 knu Exp $
+#
+###
-$cvsroot = '/home/ncvs';
-$intro = "
-This is a WWW interface to the FreeBSD CVS tree.
-You can browse the file hierarchy by picking directories
-(which have slashes after them, e.g. src/).
-If you pick a file, you will see the revision history
-for that file.
-Selecting a revision number will download that revision of
-the file. There is a link at each revision to display
-diffs between that revision and the previous one, and
-a form at the bottom of the page that allows you to
-display diffs between arbitrary revisions.
-
-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.
-";
+require 5.000;
-$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 strict;
+use vars qw (
+ $cvsweb_revision
+ $mydir $uname $config $allow_version_select $verbose
+ @CVSrepositories @CVSROOT %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
+ $checkoutMagic $doCheckout $scriptname $scriptwhere
+ $where $pathinfo $Browser $nofilelinks $maycompress
+ @stickyvars @unsafevars
+ %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 $output_filter $defaultTextPlain $defaultViewable
+ $command_path %CMD $allow_compress
+ $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
+ $hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove
+ $diffcolorChange $diffcolorAdd $diffcolorDarkChange $difffontface
+ $difffontsize $inputTextSize $mime_types
+ $allow_annotate $allow_markup
+ $allow_log_extra $allow_dir_extra $allow_source_extra
+ $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
+ $navigationHeaderColor $tableBorderColor $markupLogColor
+ $tabstop $state $annTable $sel $curbranch @HideModules @ForbiddenFiles
+ $module $use_descriptions %descriptions @mytz $dwhere $moddate
+ $use_moddate $has_zlib $gzip_open
+ $allow_tar @tar_options @gzip_options @zip_options @cvs_options
+ $LOG_FILESEPARATOR $LOG_REVSEPARATOR
+ $tmpdir $HTML_DOCTYPE $HTML_META
+);
+
+sub printDiffSelect($);
+sub printDiffLinks($$);
+sub printLogSortSelect($);
+sub findLastModifiedSubdirs(@);
+sub htmlify_sub(&$);
+sub htmlify($;$);
+sub spacedHtmlText($;$);
+sub link($$);
+sub revcmp($$);
+sub fatal($$@);
+sub redirect($);
+sub safeglob($);
+sub search_path($);
+sub getMimeTypeFromSuffix($);
+sub head($;$);
+sub scan_directives(@);
+sub openOutputFilter();
+sub doAnnotate($$);
+sub doCheckout($$);
+sub cvswebMarkup($$$);
+sub viewable($);
+sub doDiff($$$$$$);
+sub getDirLogs($$@);
+sub readLog($;$);
+sub printLog($;$);
+sub doLog($);
+sub flush_diff_rows($$$$);
+sub human_readable_diff($);
+sub navigateHeader($$$$$);
+sub plural_write($$);
+sub readableTime($$);
+sub clickablePath($$);
+sub chooseCVSRoot();
+sub chooseMirror();
+sub fileSortCmp();
+sub download_url($$;$);
+sub download_link($$$;$);
+sub toggleQuery($$);
+sub urlencode($);
+sub htmlquote($);
+sub htmlunquote($);
+sub hrefquote($);
+sub http_header(;$);
+sub html_header($);
+sub html_footer();
+sub link_tags($);
+sub forbidden_file($);
+sub forbidden_module($);
+
+##### Start of Configuration Area ########
+delete $ENV{PATH};
+
+$cvsweb_revision = '2.0.5';
+
+use File::Basename ();
+
+($mydir) = (File::Basename::dirname($0) =~ /(.*)/); # untaint
+
+# == EDIT this ==
+# Locations to search for user configuration, in order:
+for ("$mydir/cvsweb.conf", '/usr/local/etc/cvsweb/cvsweb.conf') {
+ if (defined($_) && -r $_) {
+ $config = $_;
+ last;
+ }
+}
+
+# == Configuration defaults ==
+# Defaults for configuration variables that shouldn't need
+# to be configured..
+$allow_version_select = 1;
+$allow_log_extra = 1;
+
+##### End of Configuration Area ########
+
+######## Configuration variables #########
+# These are defined to allow checking with perl -cw
+@CVSrepositories = @CVSROOT = %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS =
+ %MTYPES = %tags = %alltags = @tabcolors = %fileinfo = ();
+$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 =
+ $hr_ignkeysubst = $diffcolorHeading = $diffcolorEmpty = $diffcolorRemove =
+ $diffcolorChange = $diffcolorAdd = $diffcolorDarkChange = $difffontface =
+ $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 = $navigationHeaderColor =
+ $tableBorderColor = $markupLogColor = $tabstop = $use_moddate = $moddate =
+ $gzip_open = $HTML_DOCTYPE = $HTML_META = undef;
+$tmpdir = defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/var/tmp";
+
+$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',
+ },
+);
+
+$HTML_DOCTYPE =
+ '';
+
+$HTML_META = <
+
+
+
+EOM
+
+##### End of configuration variables #####
+
+use Time::Local ();
+use IPC::Open2 qw(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} : '';
+$where = $pathinfo;
+$doCheckout = ($where =~ m|^/$checkoutMagic/|);
+$where =~ s|^/$checkoutMagic/|/|;
+$where =~ s|^/||;
+$scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';
+$scriptname =~ s|^/*|/|;
+
+# Let's workaround thttpd's stupidity..
+if ($scriptname =~ m|/$|) {
+ $pathinfo .= '/';
+ my $re = quotemeta $pathinfo;
+ $scriptname =~ s/$re$//;
+}
+
+$scriptwhere = $scriptname;
+$scriptwhere .= '/' . urlencode($where);
+$where = '/' if ($where eq '');
+
+$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} || '';
+$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);
+
+$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} =~ m`gzip`) || $is_mozilla3) && !$is_msie
+ && !($is_mod_perl && !$has_zlib));
+
+# put here the variables we need in order
+# to hold our state - they will be added (with
+# their current value) to any link/query string
+# you construct
+@stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag);
+@unsafevars = qw(logsort only_with_tag r1 r2 rev sortby tr1 tr2);
+
+if (-f $config) {
+ do "$config" or fatal("500 Internal Error",
+ 'Error in loading configuration file: %s
%s ',
+ $config, $@);
+} else {
+ fatal("500 Internal Error",
+ 'Configuration not found. Set the variable $config in cvsweb.cgi to your cvsweb.conf configuration file first.'
+ );
+}
+
+undef %input;
+$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 "");
+ } else {
+ $input{$_}++;
+ }
+ }
+}
+
+# For backwards compability, set only_with_tag to only_on_branch if set.
+$input{only_with_tag} = $input{only_on_branch}
+ if (defined($input{only_on_branch}));
+
+# Prevent cross-site scripting
+foreach (@unsafevars) {
+ # Colons are needed in diffs between tags.
+ if (defined($input{$_}) && $input{$_} =~ /[^\w\-.:]/) {
+ fatal("500 Internal Error",
+ 'Malformed query (%s=%s)',
+ $_, $input{$_});
+ }
+}
+
+if (defined($input{"content-type"})) {
+ fatal("500 Internal Error", "Unsupported content-type")
+ if ($input{"content-type"} !~ /^[-0-9A-Za-z]+\/[-0-9A-Za-z]+$/);
+}
+
+$DEFAULTVALUE{'cvsroot'} = $cvstreedefault;
+
+foreach (keys %DEFAULTVALUE) {
+
+ # replace not given parameters with the default parameters
+ if (!defined($input{$_}) || $input{$_} eq "") {
+
+ # Empty Checkboxes in forms return -- nothing. So we define a helper
+ # variable in these forms (copt) which indicates that we just set
+ # parameters with a checkbox
+ if (!defined($input{"copt"})) {
+
+ # 'copt' isn't defined --> empty input is not the result
+ # of empty input checkbox --> set default
+ $input{$_} = $DEFAULTVALUE{$_}
+ if (defined($DEFAULTVALUE{$_}));
+ } else {
+
+ # 'copt' is defined -> the result of empty input checkbox
+ # -> set to zero (disable) if default is a boolean (0|1).
+ $input{$_} = 0
+ if (defined($DEFAULTVALUE{$_})
+ && ($DEFAULTVALUE{$_} eq "0"
+ || $DEFAULTVALUE{$_} eq "1"));
+ }
+ }
+}
+
+$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{$_}));
+ }
+}
+
+# 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
+$sortby = $input{"sortby"};
+$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'};
+
+{
+ my @tmp = @CVSrepositories;
+ my @pair;
+
+ while (@pair = splice(@tmp, 0, 2)) {
+ my ($key, $val) = @pair;
+ my ($descr, $cvsroot) = @$val;
+
+ next if !-d $cvsroot;
+
+ $CVSROOTdescr{$key} = $descr;
+ $CVSROOT{$key} = $cvsroot;
+ push @CVSROOT, $key;
+ }
+}
+
+## Default CVS-Tree
+if (!defined($CVSROOT{$cvstreedefault})) {
+ fatal("500 Internal Error",
+ '$cvstreedefault points to a repository (%s) not defined in %%CVSROOT (edit your configuration file %s)',
+ $cvstreedefault, $config);
+}
+
+# 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
+my $k;
+foreach $k (keys %ICONS) {
+ no strict 'refs';
+ my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}};
+ if ($ipath) {
+ ${"${k}icon"} =
+ sprintf(
+ '',
+ hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight)
+ } else {
+ ${"${k}icon"} = $itxt;
+ }
+}
+undef $k;
+
+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
The server on which the CVS tree lives is probably down. Please try again in a few minutes.');
}
-if (-d $fullname) {
-# Something that would be nice to support, although I have no real
-# good idea of how, would be to get full directory diff's, using
-# symbolic names (revision numbers would be meaningless).
-# The problem is finding a list of symbolic names that is common
-# to all the files in the directory.
+
#
- opendir(DIR, $fullname) || &fatal("404 Not Found","$where: $!");
- @dir = readdir(DIR);
- closedir(DIR);
- print "Content-type: text/html\n\n";
- print "
\n";
+ }
+ }
}
-sub link {
- local($name, $where) = @_;
+##
+# Function to generate Human readable diff-files
+# human_readable_diff(String revision_to_return_to);
+##
+sub human_readable_diff($) {
+ my ($difftxt, $where_nd, $filename, $pathname, $scriptwhere_nd);
+ my ($fh, $rev) = @_;
+ my ($date1, $date2, $r1d, $r2d, $r1r, $r2r, $rev1, $rev2, $sym1, $sym2);
+ my (@rightCol, @leftCol);
- "$name\n";
+ ($where_nd = $where) =~ s/.diff$//;
+ ($filename = $where_nd) =~ s/^.*\///;
+ ($pathname = $where_nd) =~ s/(Attic\/)?[^\/]*$//;
+ ($scriptwhere_nd = $scriptwhere) =~ s/.diff$//;
+
+ navigateHeader($scriptwhere_nd, $pathname, $filename, $rev, "diff");
+
+ # Read header to pick up read revision and date, if possible
+ while (<$fh>) {
+ ($r1d, $r1r) = /\t(.*)\t(.*)$/ if (/^--- /);
+ ($r2d, $r2r) = /\t(.*)\t(.*)$/ if (/^\+\+\+ /);
+ last if (/^\+\+\+ /);
+ }
+
+ if (defined($r1r) && $r1r =~ /^(\d+\.)+\d+$/) {
+ $rev1 = $r1r;
+ $date1 = $r1d;
+ }
+ if (defined($r2r) && $r2r =~ /^(\d+\.)+\d+$/) {
+ $rev2 = $r2r;
+ $date2 = $r2d;
+ }
+
+ print
+ "
Diff for /$where_nd between version $rev1 and $rev2
\n",
+ # Using style=\"border: none\" here breaks NS 4.x badly...
+ "
\n",
+ "
\n", "
",
+ "version $rev1";
+ print ", $date1" if (defined($date1));
+ print " Tag: $sym1\n" if ($sym1);
+ print "
\n", "
", "version $rev2";
+ print ", $date2" if (defined($date2));
+ print " Tag: $sym2\n" if ($sym1);
+ print "
\n";
+
+ my $leftRow = 0;
+ my $rightRow = 0;
+ my ($oldline, $newline, $funname, $diffcode, $rest);
+
+ # Process diff text
+
+ # 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]+).*@@(.*)/;
+ $funname = htmlquote($funname);
+ $funname =~ s/\s/ /go;
+ print
+ "
\n
";
+ print
+ "
\n
\n
Line $oldline";
+ print
+ " $funname
\n
\n
";
+ print "
\n
";
+ print
+ "
\n
\n
Line $newline";
+ print
+ " $funname
\n
\n
\n";
+ print "
\n";
+ $state = "dump";
+ $leftRow = 0;
+ $rightRow = 0;
+ } else {
+ ($diffcode, $rest) = $difftxt =~ /^([-+ ])(.*)/;
+ $_ = spacedHtmlText($rest, $d{'tabstop'});
+
+ #########
+ # little state machine to parse unified-diff output (Hen, zeller@think.de)
+ # in order to get some nice 'ediff'-mode output
+ # states:
+ # "dump" - just dump the value
+ # "PreChangeRemove" - we began with '-' .. so this could be the start of a 'change' area or just remove
+ # "PreChange" - okey, we got several '-' lines and moved to '+' lines -> this is a change block
+ ##########
+
+ if ($diffcode eq '+') {
+ if ($state eq "dump")
+ { # 'change' never begins with '+': just dump out value
+ print
+ "
";
+}
+
+sub plural_write($$) {
+ my ($num, $text) = @_;
+ if ($num != 1) {
+ $text .= "s";
+ }
+
+ if ($num > 0) {
+ return join (' ', $num, $text);
+ } else {
+ return "";
+ }
+}
+
+##
+# print readable timestamp in terms of
+# '..time ago'
+# H. Zeller
+##
+sub readableTime($$) {
+ my ($i, $break, $retval);
+ my ($secs, $long) = @_;
+
+ # this function works correct for time >= 2 seconds
+ if ($secs < 2) {
+ return "very little time";
+ }
+
+ my %desc = (
+ 1, 'second', 60, 'minute', 3600, 'hour',
+ 86400, 'day', 604800, 'week', 2628000, 'month',
+ 31536000, 'year'
+ );
+ my @breaks = sort { $a <=> $b } keys %desc;
+ $i = 0;
+
+ while ($i <= $#breaks && $secs >= 2 * $breaks[$i]) {
+ $i++;
+ }
+ $i--;
+ $break = $breaks[$i];
+ $retval = plural_write(int($secs / $break), $desc{$break});
+
+ if ($long == 1 && $i > 0) {
+ my $rest = $secs % $break;
+ $i--;
+ $break = $breaks[$i];
+ my $resttime = plural_write(int($rest / $break), $desc{$break});
+ if ($resttime) {
+ $retval .= ", $resttime";
+ }
+ }
+
+ return $retval;
+}
+
+##
+# clickablePath(String pathname, boolean last_item_clickable)
+#
+# returns a html-ified path whereas each directory is a link for
+# faster navigation. last_item_clickable controls whether the
+# basename (last directory/file) is a link as well
+##
+sub clickablePath($$) {
+ my ($pathname, $clickLast) = @_;
+ my $retval = '';
+
+ if ($pathname eq '/') {
+
+ # this should never happen - chooseCVSRoot() is
+ # intended to do this
+ $retval = "[$cvstree]";
+ } else {
+ $retval .= ' ' . &link("[$cvstree]",
+ sprintf('%s/%s#dirlist', $scriptname, $query));
+ my $wherepath = '';
+ my ($lastslash) = $pathname =~ m|/$|;
+
+ foreach (split (/\//, $pathname)) {
+ $retval .= " / ";
+ $wherepath .= "/$_";
+ my ($last) = "$wherepath/" eq "/$pathname"
+ || $wherepath eq "/$pathname";
+
+ if ($clickLast || !$last) {
+ $retval .= &link($_,
+ join ('', $scriptname,
+ urlencode($wherepath),
+ (!$last || $lastslash ? '/' : ''),
+ $query,
+ (!$last || $lastslash ? "#dirlist" : "")
+ ));
+ } else { # do not make a link to the current dir
+ $retval .= $_;
+ }
+ }
+ }
+ return $retval;
+}
+
+sub chooseCVSRoot() {
+
+ print "
";
+ }
+ print "\n";
+}
+
+sub chooseMirror() {
+
+ # This code comes from the original BSD-cvsweb
+ # and may not be useful for your site; If you don't
+ # set %MIRRORS this won't show up, anyway.
+ scalar(%MIRRORS) or return;
+
+ # Should perhaps exclude the current site somehow...
+ print "\n
\nThis CVSweb is mirrored in\n";
+
+ my @tmp = map(&link(htmlquote($_), $MIRRORS{$_}),
+ sort keys %MIRRORS);
+ my $tmp = pop(@tmp);
+
+ if (scalar(@tmp)) {
+ print join(', ', @tmp), ' and ';
+ }
+
+ print "$tmp.\n