[Lxr-commits] CVS: lxr/lib/LXR/Files BK.pm,1.1.2.10,1.1.2.11

[Malcolm B. <mb...@us...>]

Update of /cvsroot/lxr/lxr/lib/LXR/Files
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11983/lib/LXR/Files

Modified Files:
      Tag: bk-dev-branch
	BK.pm 
Log Message:
Add a disk-based cache for the results of the 'bk rset' command.
This prevents this from taking too long on subsequent invocations - 
bk rset being a slow operation.

As a disk-based cache this can get out of sync with the repository, 
there is currently no code to detect this.  The idea is that this would be
manually deleted before running genxref, which would have the side
effect of creating an up-to-date cache.

Index: BK.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Files/Attic/BK.pm,v
retrieving revision 1.1.2.10
retrieving revision 1.1.2.11
diff -u -d -r1.1.2.10 -r1.1.2.11
--- BK.pm	20 Feb 2005 21:42:25 -0000	1.1.2.10
+++ BK.pm	20 Feb 2005 23:44:55 -0000	1.1.2.11
@@ -28,17 +28,20 @@
 use Time::Local;
 use LXR::Common;
 
-use vars qw(%tree_cache @ISA);
+use vars qw(%tree_cache @ISA $memcachecount $diskcachecount);
 
 @ISA = ("LXR::Files");
+$memcachecount = 0;
+$diskcachecount = 0;
 
 sub new {
-	my ($self, $rootpath) = @_;
+	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;
 }
 
@@ -202,6 +205,7 @@
 
 	# Not in cache, so need to build
 	my @all_entries = $self->get_tree($release);
+	$memcachecount++;
 
 	my %newtree = ();
 	my ($entry, $path, $file, $vol, @dirs);
@@ -231,12 +235,32 @@
 
 sub get_tree {
 	my ($self, $release) = @_;
-
-	# This command provide 3 part output - the current filename, the historical filename & the revision
-	my $fileh = $self->openbkcommand("bk rset -h -l$release 2>/dev/null |");
-	my $line_to_junk = <$fileh>;    # Remove the Changelist|Changelist line at start
-	my @files        = <$fileh>;
-	close X;
+	
+	# 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
@@ -245,6 +269,11 @@
 	return @files;
 }
 
+sub cachename {
+	my ($self, $release) = @_;
+	return $self->{'cache'}."/treecache-".$release;
+}
+ 
 sub canonise {
 	my $path = shift;
 	$path =~ s!^/!!;
@@ -270,3 +299,4 @@
 	return $tree_cache{$release}{$path}{$file};
 }
 
+1;
\ No newline at end of file