view release on metacpan or  search on metacpan

lib/SVK/Command/Branch.pm  view on Meta::CPAN

    my $proj = $self->load_project($target);

    my $newtarget_path = $proj->branch_path($new_path, $self->{local});

    $self->SUPER::run(
	$self->arg_uri_maybe($newtarget_path,'New mirror site not allowed here'),
	$target
    );
    return;
}

package SVK::Command::Branch::diff;
use base qw( SVK::Command::Diff SVK::Command::Branch );
use SVK::I18N;
use SVK::Logger;

sub parse_arg {
    my ($self, @arg) = @_;
    return if $#arg > 1;

    my $dst;
    my ($proj,$target, $msg) = $self->locate_project('');
    if (!$proj) {
	$logger->warn( loc($msg));
	return ;
    }
    if (@arg) {
	my $dst_branch_path = $proj->branch_path(pop(@arg));
	$dst = $self->arg_co_maybe($dst_branch_path,'New mirror site not allowed here');
	if (@arg) {
	    my $src_branch_path = $proj->branch_path(pop(@arg));
	    $target = $self->arg_co_maybe($src_branch_path,'New mirror site not allowed here');
	}
    }

    return ($target, $dst);
}

package SVK::Command::Branch::info;
use base qw( SVK::Command::Info SVK::Command::Branch );
use SVK::I18N;
use SVK::Logger;

sub parse_arg {
    my ($self, @arg) = @_;
    @arg = ('') if $#arg < 0;

    my ($proj,$target, $msg) = $self->locate_project(pop @arg);
    if (!$proj) {
	$logger->warn( loc($msg));
	return ;
    }

    undef $self->{recursive};
    $self->{local}++ if ($target->_to_pclass("/local")->subsumes($target->path));
    push @arg, $self->dst_name($proj,$target->path);
    return map {$self->arg_co_maybe ($self->dst_path($proj,$_),'New mirror site not allowed here')} @arg;
}

package SVK::Command::Branch::setup;
use base qw( SVK::Command::Propset SVK::Command::Branch );
use SVK::I18N;
use SVK::Util qw( get_prompt );
use SVK::Logger;

sub can_write_remote_proj_prop {
    my ($self, $remote_depot, %arg) = @_;
    eval {
	for my $key (keys %arg) {
	    $self->do_propset($key,$arg{$key}, $remote_depot);
	}
    };
    return 1 if ($@);
    return 0;
}

sub parse_arg {
    my ($self, @arg) = @_;
    return if $#arg != 0;

    my $dst = shift(@arg);
    die loc ("Target can't be URI.\n")
	if $self->ensure_non_uri ($dst);

    return ($self->arg_co_maybe ($dst));
}

sub run {
    my ($self, $target) = @_;

    my $local_root = $self->arg_depotpath('/'.$target->depot->depotname.'/');
    my ($trunk_path, $branch_path, $tag_path, $project_name, $preceding_path);
    my $m = $target->is_mirrored;
    die loc("%1 is not a mirrored path.\n", $target->depotpath) if !$m;
    my $source_root = $m->_backend->source_root;
    my $url = $target->is_mirrored->url;

    for my $path ($target->depot->mirror->entries) {
	next unless $target->path =~ m{^$path};
	($trunk_path) = $target->path =~ m{^$path(/?.*)$};
	$project_name = $target->_to_pclass($target->path)->dir_list(-1);
	$project_name = $target->_to_pclass($target->path)->dir_list(-2)
	    if $project_name eq 'trunk';
	$preceding_path = $path;
	last if $trunk_path;
    }

    my $proj = $self->load_project($self->arg_depotpath('/'.$target->depot->depotname.$preceding_path));

    my $which_project = $proj->in_which_project($target) if $proj;

    my $ans = 'n';
    if ($proj && $fromProp && $which_project) {
	$project_name = $which_project;
	$logger->info( loc("Project already set in properties: %1\n", $target->depotpath));
	$ans = lc (get_prompt(
	    loc("Is the project '%1' a match? [Y/n]", $project_name)
	) );
    }
    if ($ans eq 'n') {
	$proj = $self->load_project($self->arg_depotpath($target->depotpath));
	if (!$proj) {
	    $logger->info( loc("New Project depotpath encountered: %1\n", $target->path));
	} else {
	    $logger->info( loc("Project detected in specified path.\n"));
	    $project_name = $proj->name;
	    $trunk_path = '/'.$proj->trunk;
	    $trunk_path =~ s#^/?$preceding_path##;
	    $branch_path = '/'.$proj->branch_location;
	    $branch_path =~ s{^/?$preceding_path}{};

lib/SVK/Command/Branch.pm  view on Meta::CPAN

	}
	{
	    $ans = get_prompt(
		loc("Specify a project name (enter to use '%1'): ", $project_name),
		qr/^(?:[A-Za-z][-+_A-Za-z0-9]*|$)/
	    );
	    if (length($ans)) {
		$project_name = $ans;
		last;
	    }
	}
	$trunk_path ||= $target->_to_pclass('/')->subdir('trunk');
	{
	    $ans = get_prompt(
		loc("What directory shall we use for the project's trunk? (Press ENTER to use %1)\n=>", $trunk_path),
		qr/^(?:\/?[A-Za-z][-+.A-Za-z0-9]*|$)/

	    );
	    if (length($ans)) {
		$trunk_path = $ans;
		last;
	    }
	}
	$branch_path ||= $target->_to_pclass($trunk_path)->parent->subdir('branches');
	{
	    $ans = get_prompt(
		loc("What directory shall we use for the project's branches? (Press ENTER to use %1)\n=>", $branch_path),
		qr/^(?:\/?[A-Za-z][-+.A-Za-z0-9]*|^\/|$)/
	    );
	    if (length($ans)) {
		$branch_path = $ans;
		last;
	    }
	}
	$tag_path ||= $target->_to_pclass($trunk_path)->parent->subdir('tags');
	{
	    $ans = get_prompt(
		loc("What directory shall we use for the project's tags? (Press ENTER to use %1, or 's' to skip)\n=>", $tag_path),
		qr/^(?:\/?[A-Za-z][-+.A-Za-z0-9]*|$)/
	    );
	    if (length($ans)) {
		$tag_path = $ans;
		$tag_path = '' if lc($ans) eq 's';
		last;
	    }
	}
	#XXX implement setting properties of project here
	$self->{message} = "- Setup properties for project $project_name";
	# always set to local first
	my $root_depot = $self->arg_depotpath('/'.$target->depot->depotname.$preceding_path);
	my $ret = $source_root ne $url or $self->can_write_remote_proj_prop($root_depot,
	    "svk:project:$project_name:path-trunk" => $trunk_path,
	    "svk:project:$project_name:path-branches" => $branch_path,
	    "svk:project:$project_name:path-tags" => $tag_path);
	if ($ret or $@) { # we have problem to write to remote
	    if ($source_root ne $url) {
		$logger->info( loc("Can't write project props to remote root. Save in local instead."));
	    } else {
		$logger->info( loc("Can't write project props to remote server. Save in local instead."));
	    }
	    $self->do_propset("svk:project:$project_name:path-trunk",$trunk_path, $local_root);
	    $self->do_propset("svk:project:$project_name:path-branches",$branch_path, $local_root);
	    $self->do_propset("svk:project:$project_name:path-tags",$tag_path, $local_root);
	    $self->do_propset("svk:project:$project_name:root",$preceding_path, $local_root);
	}
	$proj = SVK::Project->create_from_prop($target,$project_name);
	# XXX: what if it still failed here? How to rollback the prop commits?
	if (!$proj) {
	    $logger->info( loc("Project setup failed.\n"));
	} else {
	    $logger->info( loc("Project setup success.\n"));
	}
	return;
    }
    return;
}

package SVK::Command::Branch::online;
use base qw( SVK::Command::Branch::move SVK::Command::Smerge SVK::Command::Switch );
use SVK::I18N;
use SVK::Logger;

sub lock { $_[0]->lock_target ($_[1]); };

sub parse_arg {
    my ($self, $arg) = @_;
    die loc ("Destination can't be URI.\n")
	if $self->ensure_non_uri ($arg);

    my ($proj,$target, $msg) = $self->locate_project('');
    $self->{switch} = 1 if $target->isa('SVK::Path::Checkout');
    # XXX: should we verbose the branch_name here?
#    die loc ("Current branch '%1' already online\n", $self->{branch_name})
    die loc ("Current branch already online\n")
	if (!$target->_to_pclass("/local")->subsumes($target->path));

    unless ($proj) {
	$logger->warn( loc ($msg) );
    }

    # local
    $self->{branch_name} = $arg if $arg;
    $self->{branch_name} = $proj->branch_name($target->path, 1)
	unless $arg;
    # XXX: should provide a more generalized function for local/remote trunk switching
    $self->{branch_name} = 'trunk' if $self->{branch_name} eq $proj->name."-trunk";

    # check existence of remote branch
    my $dst;
#    if ($arg) { # user specify a new target branch
	$dst = $self->arg_depotpath($proj->branch_path($self->{branch_name}));
#    } else { # otherwise, merge back to its ancestor
#	my $copy_ancestor = ($target->copy_ancestors)[0]->[0];
#	$dst = $self->arg_depotpath('/'.$target->depotname.$copy_ancestor);
#    }
    if ($SVN::Node::none != $dst->root->check_path($dst->path)) {
	$self->{go_smerge} = $dst->depotpath if $target->related_to($dst);
    }

    return ($target, $self->{branch_name}, $target->depotpath);
}

sub run {
    my ($self, $target, @args) = @_;