SOURCES: lxr-CVS20060222.patch (NEW) - numerous fixes and bitkeepe...
baggins
baggins at pld-linux.org
Wed Feb 22 20:35:35 CET 2006
Author: baggins Date: Wed Feb 22 19:35:35 2006 GMT
Module: SOURCES Tag: HEAD
---- Log message:
- numerous fixes and bitkeeper support
---- Files affected:
SOURCES:
lxr-CVS20060222.patch (NONE -> 1.1) (NEW)
---- Diffs:
================================================================
Index: SOURCES/lxr-CVS20060222.patch
diff -u /dev/null SOURCES/lxr-CVS20060222.patch:1.1
--- /dev/null Wed Feb 22 20:35:35 2006
+++ SOURCES/lxr-CVS20060222.patch Wed Feb 22 20:35:30 2006
@@ -0,0 +1,1623 @@
+diff -urN -x CVS -x .cvsignore lxr-0.9.4/INSTALL lxr/INSTALL
+--- lxr-0.9.4/INSTALL 2005-01-05 18:13:20.000000000 +0100
++++ lxr/INSTALL 2005-11-03 00:39:55.000000000 +0100
+@@ -26,6 +26,10 @@
+
+ 7) If using the CVS support, you will need rcs installed as well.
+
++8) If you are using the BitKeeper support, you will need:
++ BitKeeper (bk) installed
++ Digest::SHA module (available from CPAN)
++
+ Installing the database
+ -----------------------
+ You will need to create a database for lxr, and possibly create a user
+diff -urN -x CVS -x .cvsignore lxr-0.9.4/diff lxr/diff
+--- lxr-0.9.4/diff 2004-10-26 19:08:07.000000000 +0200
++++ lxr/diff 2005-11-03 00:39:55.000000000 +0100
+@@ -1,5 +1,5 @@
+ #!/usr/bin/perl -T
+-# $Id$
++# $Id$
+
+ # diff -- Display diff output with markup.
+ #
+@@ -23,7 +23,7 @@
+
+ ######################################################################
+
+-$CVSID = '$Id$ ';
++$CVSID = '$Id$ ';
+
+ use strict;
+ use lib '.'; # for Local.pm
+@@ -31,6 +31,7 @@
+
+ use LXR::Common qw(:html);
+ use Local;
++use FileHandle;
+
+ sub htmlsub {
+ my ($s, $l) = @_;
+diff -urN -x CVS -x .cvsignore lxr-0.9.4/fixhashbang lxr/fixhashbang
+--- lxr-0.9.4/fixhashbang 1999-09-22 12:32:49.000000000 +0200
++++ lxr/fixhashbang 1970-01-01 01:00:00.000000000 +0100
+@@ -1,12 +0,0 @@
+-#!/bin/sh
+-
+-if [ -z "$1" ]; then
+- echo First argument must be path of desired Perl interpreter.
+- exit 0;
+-fi
+-
+-for f in `ls -ld ./* | grep '^-..x' | cut -d/ -f2`; do
+- sed -e "1s,^#!.*perl.*,#!$1," < $f > $f.new
+- cp $f.new $f
+- rm $f.new
+-done
+diff -urN -x CVS -x .cvsignore lxr-0.9.4/genjavaclasses lxr/genjavaclasses
+--- lxr-0.9.4/genjavaclasses 1999-04-09 12:18:01.000000000 +0200
++++ lxr/genjavaclasses 1970-01-01 01:00:00.000000000 +0100
+@@ -1,70 +0,0 @@
+-#!/usr/bin/perl
+-#
+-# added by jmason to support identifying references to java system classes in
+-# LXR-cross-referenced .java files.
+-#
+-# This only needs to be run when a new version of the Java system class set is
+-# released. The bundled JavaClassList.pm should do the trick nicely.
+-#
+-# This tool requires that the Info-Zip tool 'zipinfo' is installed in the PATH.
+-
+-use lib 'lib/';
+-
+-if (!defined ($ARGV[0])) {
+- die "usage: genjavaclasses { java_classes.zip | java_classes.jar }\n";
+-}
+-
+-$classes_zip = $ARGV[0];
+-open (ZIPINFO, "zipinfo $classes_zip |")
+- || die "cannot run 'zipinfo $classes_zip'\n";
+-
+-$outfile = $INC[0]."/JavaClassList.pm";
+-open (OUT, "> $outfile.new") || die "cannot write to '$outfile.new'\n";
+-
+-print OUT '# [Generated by genjavaclasses at '.localtime().']
+-
+- package JavaClassList;
+- require Exporter;
+- @ISA = qw(Exporter);
+- @EXPORT = qw(&is_java_class);
+-
+- sub is_java_class {
+- local ($name, @imported_packages) = @_;
+- local ($_);
+-
+- if (!defined %java_system_classes) {
+- foreach $_ (@java_system_classes) { $java_system_classes{$_} = 1; }
+- }
+-
+- if (defined ($java_system_classes{$name})) { return 1; }
+-
+- foreach $_ (@imported_packages) {
+- if (defined ($java_system_classes{$_.$name})) { return 1; }
+- }
+- 0;
+- }
+-
+- @java_system_classes = qw(
+- # AUTOMATICALLY GENERATED LIST STARTS HERE
+-';
+-
+-while (<ZIPINFO>) {
+- / (\S+)\.class\s*$/ || next;
+- $_ = $1; s,/,.,g; print OUT "\t$_\n";
+-}
+-close ZIPINFO || die "'zipinfo $classes_zip' failed\n";
+-
+-print OUT '
+- # AUTOMATICALLY GENERATED LIST ENDS HERE
+- );
+-
+- 1;
+-';
+-
+-if (-r $outfile) {
+- rename ($outfile, "$outfile.bak") || die "rename of $outfile failed\n";
+-}
+-rename ("$outfile.new", $outfile) || die "rename to $outfile failed\n";
+-exit;
+-
+-# vim:sw=4:
+diff -urN -x CVS -x .cvsignore lxr-0.9.4/genxref lxr/genxref
+--- lxr-0.9.4/genxref 2004-07-21 22:44:30.000000000 +0200
++++ lxr/genxref 2005-11-03 00:39:55.000000000 +0100
+@@ -51,6 +51,7 @@
+ --version=VERSION Generate tokens for the given version of the code.
+ --allversions Generate tokens for all versions of the code (default).
+ --reindexall Purges existing index data
++
+ Report bugs at http://sourceforge.net/projects/lxr/.
+ END_HELP
+ exit 0;
+@@ -67,7 +68,7 @@
+
+ die("No matching configuration") unless $config->sourceroot;
+
+-$files = new LXR::Files($config->sourceroot);
++$files = new LXR::Files($config->sourceroot, $config->sourceparams);
+ die "Can't create file access object " . $config->sourceroot
+ if !defined($files);
+ $index = new LXR::Index($config->dbname, O_RDWR | O_CREAT);
+diff -urN -x CVS -x .cvsignore lxr-0.9.4/lib/LXR/Common.pm lxr/lib/LXR/Common.pm
+--- lxr-0.9.4/lib/LXR/Common.pm 2005-05-05 01:19:33.000000000 +0200
++++ lxr/lib/LXR/Common.pm 2005-11-03 00:39:55.000000000 +0100
+@@ -1,6 +1,6 @@
+ # -*- tab-width: 4 -*- ###############################################
+ #
+-# $Id$
++# $Id$
+ #
+ # FIXME: java doesn't support super() or super.x
+
+@@ -20,7 +20,7 @@
+
+ package LXR::Common;
+
+-$CVSID = '$Id$ ';
++$CVSID = '$Id$ ';
+
+ use strict;
+
+@@ -169,7 +169,6 @@
+ return (undef);
+ }
+
+- $t =~ s/\+/ /g;
+ $t =~ s/\%([\da-f][\da-f])/pack("C", hex($1))/gie;
+
+ return ($t);
+@@ -494,7 +493,7 @@
+
+ $config = new LXR::Config($HTTP->{'this_url'});
+ die "Can't find config for " . $HTTP->{'this_url'} if !defined($config);
+- $files = new LXR::Files($config->sourceroot);
++ $files = new LXR::Files($config->sourceroot, $config->sourceparams);
+ die "Can't create Files for " . $config->sourceroot if !defined($files);
+ $index = new LXR::Index($config->dbname);
+ die "Can't create Index for " . $config->dbname if !defined($index);
+@@ -539,10 +538,10 @@
+
+ if(defined $path) {
+ # First suppress anything after a dodgy character
+- $path =~ s!(^[\w_+-,.%^/]+).*!$1!;
++ $path =~ s!(^[\w_+\-,.%^/\!]+).*!$1!;
+ # Clean out /../
+- while ($path =~ m!/../!) {
+- $path = s!/\.\./!/!g;
++ while ($path =~ m!/\.\.?/!) {
++ $path =~ s!/\.\.?/!/!g;
+ }
+ }
+
+diff -urN -x CVS -x .cvsignore lxr-0.9.4/lib/LXR/Config.pm lxr/lib/LXR/Config.pm
+--- lxr-0.9.4/lib/LXR/Config.pm 2004-07-21 22:44:30.000000000 +0200
++++ lxr/lib/LXR/Config.pm 2005-09-10 02:09:20.000000000 +0200
+@@ -1,6 +1,6 @@
+ # -*- tab-width: 4 -*- ###############################################
+ #
+-# $Id$
++# $Id$
+
+ # This program is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU General Public License as published by
+@@ -18,7 +18,7 @@
+
+ package LXR::Config;
+
+-$CVSID = '$Id$ ';
++$CVSID = '$Id$ ';
+
+ use strict;
+
+@@ -106,8 +106,16 @@
+ }
+ }
+ }
+-
+- die "Can't find config for $url\n" if !defined $$self{baseurl};
++
++ if(!defined $$self{baseurl}) {
++ if($url =~ m!http://.+\.!) {
++ die "Can't find config for $url: make sure there is a 'baseurl' line that matches in lxr.conf\n";
++ } else {
++ # wasn't a url, so probably genxref with a bad --url parameter
++ die "Can't find config for $url: " .
++ "the --url parameter should be a URL (e.g. http://example.com/lxr) and must match a baseurl line in lxr.conf\n";
++ }
++ }
+ }
+
+ sub allvariables {
+diff -urN -x CVS -x .cvsignore lxr-0.9.4/lib/LXR/Files/BK.pm lxr/lib/LXR/Files/BK.pm
+--- lxr-0.9.4/lib/LXR/Files/BK.pm 1970-01-01 01:00:00.000000000 +0100
++++ lxr/lib/LXR/Files/BK.pm 2005-11-03 00:39:55.000000000 +0100
+@@ -0,0 +1,305 @@
++# -*- tab-width: 4 -*- ###############################################
++#
++# $Id$
++
++# This program is free software; you can redistribute it and/or modify
++# it under the terms of the GNU General Public License as published by
++# the Free Software Foundation; either version 2 of the License, or
++# (at your option) any later version.
++#
++# This program is distributed in the hope that it will be useful,
++# but WITHOUT ANY WARRANTY; without even the implied warranty of
++# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
++# GNU General Public License for more details.
++#
++# You should have received a copy of the GNU General Public License
++# along with this program; if not, write to the Free Software
++# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
++
++package LXR::Files::BK;
++
++$CVSID = '$Id$ ';
++
++use strict;
++use File::Spec;
++use Cwd;
++use IO::File;
++use Digest::SHA qw(sha1_hex);
++use Time::Local;
++use LXR::Common;
++
++use vars qw(%tree_cache @ISA $memcachecount $diskcachecount);
++
++ at ISA = ("LXR::Files");
++$memcachecount = 0;
++$diskcachecount = 0;
++
++sub new {
++ my ($self, $rootpath, $params) = @_;
++
++ $self = bless({}, $self);
++ $self->{'rootpath'} = $rootpath;
++ $self->{'rootpath'} =~ s!/*$!!;
++ die "Must specify a cache directory when using BitKeeper" if !(ref($params) eq 'HASH');
++ $self->{'cache'} = $$params{'cachepath'};
++ return $self;
++}
++
++#
++# Public interface
++#
++
++sub getdir {
++ my ($self, $pathname, $release) = @_;
++
++ $self->fill_cache($release);
++ $pathname = canonise($pathname);
++ $pathname = File::Spec->rootdir() if $pathname eq '';
++ my @nodes = keys %{ $tree_cache{$release}->{$pathname} };
++ my @dirs = grep m!/$!, @nodes;
++ my @files = grep !m!/$!, @nodes;
++ return (sort(@dirs), sort(@files));
++}
++
++sub getfile {
++ my ($self, $pathname, $release) = @_;
++ $pathname = canonise($pathname);
++ my $fileh = $self->getfilehandle($pathname, $release);
++
++ return undef unless $fileh;
++ my $buffer = join('', $fileh->getlines);
++ close $fileh;
++ return $buffer;
++}
++
++sub getfilehandle {
++ my ($self, $pathname, $release) = @_;
++ $pathname = canonise($pathname);
++ my $fileh = undef;
++ if ($self->file_exists($pathname, $release)) {
++ my $info = $self->getfileinfo($pathname, $release);
++ my $ver = $info->{'revision'};
++ my $where = $info->{'curpath'};
++ $fileh = $self->openbkcommand("bk get -p -r$ver $where 2>/dev/null |");
++ }
++ return $fileh;
++}
++
++sub filerev {
++ my ($self, $filename, $release) = @_;
++
++ my $info = $self->getfileinfo($filename, $release);
++ return sha1_hex($info->{'curpath'} . '-' . $info->{'revision'});
++}
++
++sub getfiletime {
++ my ($self, $pathname, $release) = @_;
++
++ my $info = $self->getfileinfo($pathname, $release);
++ return undef if !defined $info;
++
++ if (!defined($info->{'filetime'})) {
++ my $fileh = $self->openbkcommand("bk prs -r$info->{'revision'} -h -d:UTC: $info->{'curpath'} |");
++ my $time = <$fileh>; # Should be a YYYYMMDDHHMMSS string
++ close $fileh;
++ chomp $time;
++ my ($yr, $mth, $day, $hr, $min, $sec) =
++ $time =~ m/(....)(..)(..)(..)(..)(..)/;
++ $info->{'filetime'} = timegm($sec, $min, $hr, $day, $mth-1, $yr);
++ }
++
++ return $info->{'filetime'};
++}
++
++sub getfilesize {
++ my ($self, $pathname, $release) = @_;
++
++ my $info = $self->getfileinfo($pathname, $release);
++ return undef if !defined($info);
++
++ if (!defined($info->{'filesize'})) {
++ $info->{'filesize'} = length($self->getfile($pathname, $release));
++ }
++ return $info->{'filesize'};
++}
++
++
++sub getauthor {
++ my ($self, $pathname, $release) = @_;
++
++ my $info = $self->getfileinfo($pathname, $release);
++ return undef if !defined $info;
++
++ if (!defined($info->{'author'})) {
++ my $fileh = $self->openbkcommand("bk prs -r$info->{'revision'} -h -d:USER: $info->{'curpath'} |");
++ my $user = <$fileh>;
++ close $fileh;
++ chomp $user;
++ $info->{'author'} = $user;
++ }
++
++ return $info->{'author'};
++}
++
++sub getannotations {
++ # No idea what this function should return - Plain.pm returns (), so do that
++ return ();
++}
++
++sub openbkcommand {
++ my ($self, $command) = @_;
++
++ my $dir = getcwd();
++ chdir($self->{'rootpath'});
++ my $fileh = new IO::File;
++ $fileh->open($command) or die "Can't execute $command";
++ chdir($dir);
++ return $fileh;
++}
++
++sub isdir {
++ my ($self, $pathname, $release) = @_;
++ $self->fill_cache($release);
++ $pathname = canonise($pathname);
++ my $info = $tree_cache{$release}{$pathname};
++ return (defined($info));
++}
++
++sub isfile {
++ my ($self, $pathname, $release) = @_;
++ my $info = $self->getfileinfo($pathname, $release);
++ return (defined($info));
++}
++
++sub tmpfile {
++ my ($self, $filename, $release) = @_;
++ my ($tmp, $buf);
++
++ $buf = $self->getfile($filename, $release);
++ return undef unless defined($buf);
++
++ $tmp =
++ $config->tmpdir
++ . '/bktmp.'
++ . time . '.'
++ . $$ . '.'
++ . &LXR::Common::tmpcounter;
++ open(TMP, "> $tmp") || return undef;
++ print(TMP $buf);
++ close(TMP);
++
++ return $tmp;
++}
++
++#
++# Private interface
++#
++
++sub insert_entry {
++ my ($newtree, $path, $entry, $curfile, $rev) = @_;
++ $$newtree{$path} = {} if !defined($$newtree{$path});
++ $newtree->{$path}{$entry} = { 'curpath' => $curfile, 'revision' => $rev };
++}
++
++sub fill_cache {
++ my ($self, $release) = @_;
++
++ return if (defined $tree_cache{$release});
++
++ # Not in cache, so need to build
++ my @all_entries = $self->get_tree($release);
++ $memcachecount++;
++
++ my %newtree = ();
++ my ($entry, $path, $file, $vol, @dirs);
++ my ($curfile, $histfile, $rev);
++ $newtree{''} = {};
++
++ foreach $entry (@all_entries) {
++ ($curfile, $histfile, $rev) = split /\|/, $entry;
++ ($vol, $path, $file) = File::Spec->splitpath($histfile);
++ insert_entry(\%newtree, $path, $file, $curfile, $rev);
++ while ($path ne File::Spec->rootdir() && $path ne '') {
++
++ # Insert any directories in path into hash
++ ($vol, $path, $file) =
++ File::Spec->splitpath(
++ File::Spec->catdir(File::Spec->splitdir($path)));
++ insert_entry(\%newtree, $path, $file . '/');
++ }
++ }
++
++ # Make / point to ''
++ $newtree{ File::Spec->rootdir() } = $newtree{''};
++ delete $newtree{''};
++
++ $tree_cache{$release} = \%newtree;
++}
++
++sub get_tree {
++ my ($self, $release) = @_;
++
++ # Return entire tree as provided by 'bk rset'
++ # First, check if cache exists
++
++ my $fileh = new IO::File;
++
++ if (-r $self->cachename($release)) {
++ $fileh->open($self->cachename($release)) or die "Whoops, can't open cached version";
++ } else {
++ # This command provide 3 part output - the current filename, the historical filename & the revision
++ $fileh = $self->openbkcommand("bk rset -h -l$release 2>/dev/null |");
++ my $line_to_junk = <$fileh>; # Remove the Changelist|Changelist line at start
++ # Now create the cached copy if we can
++ if(open(CACHE, ">", $self->cachename($release))) {
++ $diskcachecount++;
++ my @data = <$fileh>;
++ close $fileh;
++ print CACHE @data;
++ close CACHE;
++ $fileh = new IO::File;
++ $fileh->open($self->cachename($release)) or die "Couldn't open cached version!";
++ }
++ }
++
++ my @files = <$fileh>;
++ close $fileh;
++ chomp @files;
++
++ # remove any BitKeeper metadata except for deleted files
++ @files = grep (!(m!^BitKeeper! && !m!^BitKeeper/deleted/!), @files);
++
++ return @files;
++}
++
++sub cachename {
++ my ($self, $release) = @_;
++ return $self->{'cache'}."/treecache-".$release;
++}
++
++sub canonise {
++ my $path = shift;
++ $path =~ s!^/!!;
++ return $path;
++}
++
++# Check that the specified pathname, version combination exists in repository
++sub file_exists {
++ my ($self, $pathname, $release) = @_;
++
++ # Look the file up in the treecache
++ return defined($self->getfileinfo($pathname, $release));
++}
++
++sub getfileinfo {
++ my ($self, $pathname, $release) = @_;
++ $self->fill_cache($release); # Normally expect this to be present anyway
++ $pathname = canonise($pathname);
++
++ my ($vol, $path, $file) = File::Spec->splitpath($pathname);
++ $path = File::Spec->rootdir() if $path eq '';
++
++ return $tree_cache{$release}{$path}{$file};
++}
++
++1;
+\ No newline at end of file
+diff -urN -x CVS -x .cvsignore lxr-0.9.4/lib/LXR/Files/Plain.pm lxr/lib/LXR/Files/Plain.pm
+--- lxr-0.9.4/lib/LXR/Files/Plain.pm 2004-07-21 22:44:31.000000000 +0200
++++ lxr/lib/LXR/Files/Plain.pm 2005-11-03 00:39:55.000000000 +0100
+@@ -1,6 +1,6 @@
+ # -*- tab-width: 4 -*- ###############################################
+ #
+-# $Id$
++# $Id$
+
+ # This program is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU General Public License as published by
+@@ -18,7 +18,7 @@
+
+ package LXR::Files::Plain;
+
+-$CVSID = '$Id$ ';
++$CVSID = '$Id$ ';
+
+ use strict;
+ use FileHandle;
+@@ -100,6 +100,10 @@
+ my ($self, $pathname, $release) = @_;
+ my ($dir, $node, @dirs, @files);
+
++ if($pathname !~ m!/$!) {
++ $pathname = $pathname . '/';
++ }
++
+ $dir = $self->toreal($pathname, $release);
+ opendir(DIR, $dir) || return ();
+ FILE: while (defined($node = readdir(DIR))) {
+@@ -164,14 +168,4 @@
+ return %index;
+ }
+
+-sub allreleases {
+- my ($self, $filename) = @_;
+-
+- opendir(SRCDIR, $self->{'rootpath'});
+- my @dirs = readdir(SRCDIR);
<<Diff was trimmed, longer than 597 lines>>
More information about the pld-cvs-commit
mailing list