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

[nobody at bestpractical.com]

Author: clsung
Date: Fri Oct 19 11:08:33 2007
New Revision: 2551

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

Log:
- create Project from given path
  - currently, mirror path only '//mirror/MyProject'
- TODO, checkout path
  - svk co //mirror/MyPorject abc; cd abc; ...

Modified: branches/bm/lib/SVK/Project.pm
==============================================================================
--- branches/bm/lib/SVK/Project.pm	(original)
+++ branches/bm/lib/SVK/Project.pm	Fri Oct 19 11:08:33 2007
@@ -108,4 +108,47 @@
     return \@branches;
 }
 
+sub create_from_path {
+    my ($self, $xd, $arg) = @_;
+    my $root;
+    my $rev = undef;
+    my ($depot, $path) = $xd->find_depotpath($arg);
+    my $view;
+    if (($view) = $path =~ m{^/\^([\w\-_/]+)$}) {
+	($path, $view) = $self->create_view($depot->repos, $view, $rev);
+    }
+
+    my $path_obj = $xd->create_path_object
+	( depot => $depot,
+	  path => $path,
+	  report => $arg,
+	  revision => $rev,
+	  view => $view,
+	);
+
+    my $depotpath = $path_obj->{path};
+    my ($project_name) = $depotpath =~ m{^/.*/([\w\-_]+)(?:/(?:trunk|branches|tags))?};
+
+    return 0 unless $project_name; # so? 0 means? need to deal with it.
+
+    my $mirror_path = "/mirror";
+    my ($trunk_path, $branch_path, $tag_path) = 
+	map { $mirror_path."/".$project_name."/".$_ } ('trunk', 'branches', 'tags');
+    # check trunk, branch, tag, these should be metadata-ed 
+    for my $_path ($trunk_path, $branch_path, $tag_path) {
+	# we check if the structure of mirror is correct
+	# need more handle here
+	die $! unless $SVN::Node::dir == $path_obj->root->check_path($_path);
+    }
+    return SVK::Project->new(
+	{   
+	    name            => $project_name,
+	    depot           => $path_obj->depot,
+	    trunk           => $trunk_path,
+	    branch_location => $branch_path,
+	    tag_location    => $tag_path,
+	    local_root      => "/local/${project_name}",
+	});
+}
+
 1;

Added: branches/bm/t/api/project_from_path.t
==============================================================================
--- (empty file)
+++ branches/bm/t/api/project_from_path.t	Fri Oct 19 11:08:33 2007
@@ -0,0 +1,39 @@
+#!/usr/bin/perl -w
+use strict;
+use SVK::Test;
+use Data::Dumper; # diag
+plan tests => 3;
+our $output;
+
+use_ok('SVK::Project');
+
+my ($xd, $svk) = build_test('test');
+
+$svk->mkdir(-m => 'trunk', '/test/trunk');
+$svk->mkdir(-m => 'trunk', '/test/branches');
+$svk->mkdir(-m => 'trunk', '/test/tags');
+my $tree = create_basic_tree($xd, '/test/trunk');
+
+my $depot = $xd->find_depot('test');
+my $uri = uri($depot->repospath);
+
+$svk->mirror('//mirror/MyProject', $uri);
+$svk->sync('//mirror/MyProject');
+
+# When the path is mirror path
+my $proj = SVK::Project->create_from_path($xd, '//mirror/MyProject');
+isa_ok($proj, 'SVK::Project');
+
+my $proj2 = SVK::Project->new(
+    {   name            => 'MyProject',
+        depot           => $xd->find_depot(''),
+        trunk           => '/mirror/MyProject/trunk',
+        branch_location => '/mirror/MyProject/branches',
+        tag_location    => '/mirror/MyProject/tags',
+        local_root      => '/local/MyProject',
+    });
+
+is_deeply ($proj, $proj2, 'The same project?');
+
+# TODO
+# When the path is checkout-ed path