[svk-commit] r2549 - in branches/bm: t/api

[nobody at bestpractical.com]

Author: clkao
Date: Fri Oct 19 04:54:53 2007
New Revision: 2549

Modified:
   branches/bm/lib/SVK/Project.pm
   branches/bm/t/api/project.t

Log:
make find_branches work.

Modified: branches/bm/lib/SVK/Project.pm
==============================================================================
--- branches/bm/lib/SVK/Project.pm	(original)
+++ branches/bm/lib/SVK/Project.pm	Fri Oct 19 04:54:53 2007
@@ -53,7 +53,8 @@
 use SVK::Version;  our $VERSION = $SVK::VERSION;
 use base 'Class::Accessor::Fast';
 
-__PACKAGE__->mk_accessors(qw(name trunk branch_location tag_location local_root));
+__PACKAGE__->mk_accessors(
+    qw(name trunk branch_location tag_location local_root depot));
 
 =head1 NAME
 
@@ -69,10 +70,42 @@
 
 =cut
 
+use List::MoreUtils 'apply';
+
 sub branches {
-    my ($self, $match) = @_;
+    my ( $self, $match ) = @_;
+
+    my $fs              = $self->depot->repos->fs;
+    my $root            = $fs->revision_root( $fs->youngest_rev );
+    my $branch_location = $self->branch_location;
+
+    return [ apply {s{^\Q$branch_location\E/}{}}
+        @{ $self->_find_branches( $root, $self->branch_location ) } ];
+}
 
-    return [];
+sub _find_branches {
+    my ( $self, $root, $path ) = @_;
+    my $pool    = SVN::Pool->new_default;
+    my $entries = $root->dir_entries($path);
+
+    my $trunk = SVK::Path->real_new(
+        {   depot    => $self->depot,
+            revision => $root->revision_root_revision,
+            path     => $self->trunk
+        }
+    );
+
+    my @branches;
+
+    for my $entry ( sort keys %$entries ) {
+        next unless $entries->{$entry}->kind == $SVN::Node::dir;
+        my $b = $trunk->mclone( path => $path . '/' . $entry );
+
+        push @branches, $b->related_to($trunk)
+            ? $b->path
+            : @{ $self->_find_branches( $root, $path . '/' . $entry ) };
+    }
+    return \@branches;
 }
 
 1;

Modified: branches/bm/t/api/project.t
==============================================================================
--- branches/bm/t/api/project.t	(original)
+++ branches/bm/t/api/project.t	Fri Oct 19 04:54:53 2007
@@ -17,6 +17,7 @@
 my $uri = uri($depot->repospath);
 
 $svk->mirror('//mirror/MyProject', $uri);
+$svk->sync('//mirror/MyProject');
 
 my $proj = SVK::Project->new(
     {   name            => 'MyProject',
@@ -31,10 +32,10 @@
 
 is_deeply($proj->branches, [], 'no branches yet');
 
-$svk->cp(-m => 'branch Foo', '//mirror/MyProject', '//mirror/branches/Foo');
+$svk->cp(-m => 'branch Foo', '//mirror/MyProject/trunk', '//mirror/MyProject/branches/Foo');
 
 is_deeply($proj->branches, ['Foo'], 'found 1 branch');
 
-$svk->cp(-pm => 'feature branch Bar', '//mirror/MyProject', '//mirror/branches/feature/Bar');
+$svk->cp(-pm => 'feature branch Bar', '//mirror/MyProject/trunk', '//mirror/MyProject/branches/feature/Bar');
 
 is_deeply($proj->branches, ['Foo', 'feature/Bar'], 'found deep branches');