[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