[svk-devel] Re: "svk info" latency vs. vc-svk.el: pain vs. gain
David Glasser
glasser at mit.edu
Fri Aug 4 11:51:00 EDT 2006
On 8/4/06, Chip Salzenberg <chip at pobox.com> wrote:
> Sadly that's not enough; vc-svk needs to know at the file level.
You folks are so picky.
#!/usr/bin/env perl
use strict;
use warnings;
use YAML::Syck;
use Data::Hierarchy 0.30;
use Cwd;
use File::Spec::Functions;
use Path::Class;
use SVN::Core;
use SVN::Repos;
use SVN::Fs;
# Doesn't deal with Windows, symlinks, or floating checkouts.
@ARGV <= 1 or die "usage: $0 [filename]\n";
my $file = @ARGV ? $ARGV[0] : '';
my $abspath = Cwd::abs_path($file);
my $xd = YAML::Syck::LoadFile("$ENV{HOME}/.svk/config");
my $hierarchy = $xd->{checkout};
my $SEP = '/';
sub abs2rel {
my ($pathname, $old_basedir, $new_basedir, $sep) = @_;
my $rel = File::Spec::Functions::abs2rel($pathname, $old_basedir);
if ($rel =~ /(?:\A|\Q$SEP\E)\.\.(?:\Q$SEP\E|\z)/o) {
$rel = $pathname;
}
elsif (defined $new_basedir) {
$rel = catdir($new_basedir, $rel);
}
# resemble file::spec pre-3.13 behaviour, return empty string.
return '' if $rel eq '.';
$rel =~ s/\Q$SEP/$sep/go if $sep and $SEP ne $sep;
return $rel;
}
sub find_repos {
my ($depotpath) = @_;
my ($depot, $path) = $depotpath =~ m|^/([^/]*)(/.*?)/?$|
or die "$depotpath is not a depot path.\n";
$path = Path::Class::foreign_dir('Unix', $path)->stringify;
my $repospath = $xd->{depotmap}{$depot} or die "No such depot: $depot.\n";
return ($repospath, $path);
}
my ($entry, $coroot) = $hierarchy->get($abspath);
my $rev = $entry->{revision};
my $depotpath = $entry->{depotpath};
exit 1 unless defined $rev and defined $depotpath;
if ($entry->{'.schedule'}) {
print "$entry->{'.schedule'}\n";
exit 0;
}
my ($repospath, $anchor) = find_repos($depotpath);
my $svnpath = abs2rel($abspath, $coroot => $anchor);
my $pool = SVN::Pool->new_default;
my $REPOS = SVN::Repos::open($repospath, $pool);
my $fs = $REPOS->fs;
my $node_type = $fs->revision_root($rev)->check_path($svnpath);
if ($node_type == $SVN::Node::none) {
exit 1;
} else {
print "$rev\n";
exit 0;
}
--
David Glasser | glasser at mit.edu | http://www.davidglasser.net/
More information about the svk-devel
mailing list