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

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

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

Modified Files:
      Tag: bk-dev-branch
	BK.pm 
Log Message:
Complete getauthor and getannotations functions.  Getannotations is a 
stub for now, since it's not clear what this should return.

Index: BK.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Files/Attic/BK.pm,v
retrieving revision 1.1.2.8
retrieving revision 1.1.2.9
diff -u -d -r1.1.2.8 -r1.1.2.9
--- BK.pm	14 Feb 2005 22:39:57 -0000	1.1.2.8
+++ BK.pm	19 Feb 2005 22:22:09 -0000	1.1.2.9
@@ -23,6 +23,7 @@
 use strict;
 use File::Spec;
 use Cwd;
+use IO::File;
 use Digest::SHA qw(sha1_hex);
 use Time::Local;
 use LXR::Common;
@@ -69,16 +70,12 @@
 	my ($self, $pathname, $release) = @_;
 	$pathname = canonise($pathname);
 	my $fileh = undef;
-	my $dir   = getcwd();
-	chdir($self->{'rootpath'});
 	if ($self->file_exists($pathname, $release)) {
-		my $info = $self->getfileinfo($pathname, $release);
-		my $ver = $info->{'revision'};
+		my $info  = $self->getfileinfo($pathname, $release);
+		my $ver   = $info->{'revision'};
 		my $where = $info->{'curpath'};
-		open($fileh, "bk get -p -r$ver $where 2>/dev/null |")
-		  or die "Error executing bk get";
+		$fileh = $self->openbkcommand("bk get -p -r$ver $where 2>/dev/null |");
 	}
-	chdir($dir);
 	return $fileh;
 }
 
@@ -86,40 +83,72 @@
 	my ($self, $filename, $release) = @_;
 
 	my $info = $self->getfileinfo($filename, $release);
-	return sha1_hex($info->{'curpath'}.'-'.$info->{'revision'});	
+	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 $dir = getcwd();
-		chdir($self->{'rootpath'});
-		open (X, "bk prs -r$info->{'revision'} -h -d:UTC: $info->{'curpath'} |");
-		my $time = <X>; # Should be a YYYYMMDDHHMMSS string
-		close X;
-		chdir($dir);
+
+	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/(....)(..)(..)(..)(..)(..)/;
+		my ($yr, $mth, $day, $hr, $min, $sec) =
+		  $time =~ m/(....)(..)(..)(..)(..)(..)/;
 		$info->{'filetime'} = timegm($sec, $min, $hr, $day, $mth, $yr);
 	}
 
-	return $info->{'filetime'};	
+	return $info->{'filetime'};
 }
 
 sub getfilesize {
 	my ($self, $pathname, $release) = @_;
-	
+
 	my $info = $self->getfileinfo($pathname, $release);
 	return undef if !defined($info);
 
-	if(!defined($info->{'filesize'})) {
+	if (!defined($info->{'filesize'})) {
 		$info->{'filesize'} = length($self->getfile($pathname, $release));
 	}
-	return $info->{'filesize'}
+	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 {
@@ -131,11 +160,11 @@
 }
 
 sub isfile {
-my ($self, $pathname, $release) = @_;
+	my ($self, $pathname, $release) = @_;
 	my $info = $self->getfileinfo($pathname, $release);
 	return (defined($info));
 }
-	
+
 sub tmpfile {
 	my ($self, $filename, $release) = @_;
 	my ($tmp,  $buf);
@@ -156,7 +185,6 @@
 	return $tmp;
 }
 
-
 #
 # Private interface
 #
@@ -169,9 +197,9 @@
 
 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);
 
@@ -185,11 +213,12 @@
 		($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.'/');
+			insert_entry(\%newtree, $path, $file . '/');
 		}
 	}
 
@@ -203,15 +232,10 @@
 sub get_tree {
 	my ($self, $release) = @_;
 
-	my $real = $self->{'rootpath'};
-	my $dir  = getcwd();
-	chdir($self->{'rootpath'});
-
-# This command provide 3 part output - the current filename, the historical filename & the revision
-	open(X, "bk rset -h -l$release 2>/dev/null |") or die "Can't exec bk rset";
-	chdir($dir);
-	my $line_to_junk = <X>;    # Remove the Changelist|Changelist line at start
-	my @files        = <X>;
+	# 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;
 	chomp @files;
 
@@ -237,13 +261,12 @@
 
 sub getfileinfo {
 	my ($self, $pathname, $release) = @_;
-	$self->fill_cache($release); # Normally expect this to be present anyway
+	$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};
 }
-