[svk-commit] r2653 - in branches/bm: t/bm

[nobody at bestpractical.com]

Author: clsung
Date: Thu Dec 20 03:25:27 2007
New Revision: 2653

Modified:
   branches/bm/lib/SVK/Command.pm
   branches/bm/t/bm/prop-autoload.t

Log:
- interactively load project when checkout new repos...

Modified: branches/bm/lib/SVK/Command.pm
==============================================================================
--- branches/bm/lib/SVK/Command.pm	(original)
+++ branches/bm/lib/SVK/Command.pm	Thu Dec 20 03:25:27 2007
@@ -471,6 +471,43 @@
     $path = $default unless length $path;
     $path = "//mirror/$path" unless $path =~ m!^/!;
 
+    # try to get prop of project first
+    #
+    $uri =~ s/\/$//;
+    my $ra = SVN::Ra->new($uri);
+    my %prop = %{ ($ra->get_file('',$ra->get_latest_revnum, undef))[1] };
+
+    my $prompt_project = loc("
+Remote repository has projects property set, do you like to use it? ");
+
+    # XXX list projects, let user choose it
+    if (grep { $_ =~ /^svk:project/ } keys %prop) {
+	my $go_for_project = lc ( get_prompt( $prompt_project . '[Y/n]' ) );
+	if ($go_for_project ne 'n') {
+	    # use first project
+	    my %projects = 
+		map { $_ => 1 }
+		grep { $_ =~ s/^svk:project:([^:]+):.*$/$1/ } keys %prop;
+	    my @projs = keys %projects;
+	    print loc("Avaliable projects:\n");
+	    print loc("No.   Project      Path\n");
+	    my $index = 0;
+	    for my $proj (@projs) {
+		$index++;
+		$projects{$proj} = '/'.$prop{'svk:project:'.$proj.':path-trunk'};
+		$projects{$proj} =~ s{/[^/]+$}{};
+		print sprintf ("%d)    %-12s %-12s\n",
+		    $index, $proj, $projects{$proj});
+	    }
+	    my $proj_answer = lc(get_prompt(
+		loc("Which project? [No.] "),
+		qr(^\d+$)
+		));
+	    $proj_answer--;
+	    $path = $projects{$projs[$proj_answer]};
+	}
+    }
+
     my $target = $self->arg_depotpath($path);
     $self->command ('mirror')->run ($target, $base_uri);
   

Modified: branches/bm/t/bm/prop-autoload.t
==============================================================================
--- branches/bm/t/bm/prop-autoload.t	(original)
+++ branches/bm/t/bm/prop-autoload.t	Thu Dec 20 03:25:27 2007
@@ -34,7 +34,7 @@
 
 $svk->mirror('--detach', '//mirror/MyProject');
 
-$answer = ['','','y',''];
+$answer = ['','','y','1', ''];
 $svk->checkout($uri,$copath);
 
 chdir($copath);