[svk-commit] r2558 - in branches/bm/lib/SVK: .

nobody at bestpractical.com nobody at bestpractical.com
Wed Oct 24 05:03:08 EDT 2007


Author: clsung
Date: Wed Oct 24 05:02:33 2007
New Revision: 2558

Added:
   branches/bm/lib/SVK/Command/Branch.pm
Modified:
   branches/bm/lib/SVK/Project.pm

Log:
- implementing (not yet!) branch --create (--switch-to)/--list
- need to write tests now!!

Added: branches/bm/lib/SVK/Command/Branch.pm
==============================================================================
--- (empty file)
+++ branches/bm/lib/SVK/Command/Branch.pm	Wed Oct 24 05:02:33 2007
@@ -0,0 +1,208 @@
+# BEGIN BPS TAGGED BLOCK {{{
+# COPYRIGHT:
+# 
+# This software is Copyright (c) 2003-2006 Best Practical Solutions, LLC
+#                                          <clkao at bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# 
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of either:
+# 
+#   a) Version 2 of the GNU General Public License.  You should have
+#      received a copy of the GNU General Public License along with this
+#      program.  If not, write to the Free Software Foundation, Inc., 51
+#      Franklin Street, Fifth Floor, Boston, MA 02110-1301 or visit
+#      their web page on the internet at
+#      http://www.gnu.org/copyleft/gpl.html.
+# 
+#   b) Version 1 of Perl's "Artistic License".  You should have received
+#      a copy of the Artistic License with this package, in the file
+#      named "ARTISTIC".  The license is also available at
+#      http://opensource.org/licenses/artistic-license.php.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of the
+# GNU General Public License and is only of importance to you if you
+# choose to contribute your changes and enhancements to the community
+# by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with SVK,
+# to Best Practical Solutions, LLC, you confirm that you are the
+# copyright holder for those contributions and you grant Best Practical
+# Solutions, LLC a nonexclusive, worldwide, irrevocable, royalty-free,
+# perpetual, license to use, copy, create derivative works based on
+# those contributions, and sublicense and distribute those contributions
+# and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+package SVK::Command::Branch;
+use strict;
+use SVK::Version;  our $VERSION = $SVK::VERSION;
+
+use base qw( SVK::Command::Commit );
+use SVK::I18N;
+use SVK::Util qw( is_uri get_prompt traverse_history );
+use SVK::Project;
+
+use constant narg => undef;
+
+sub options {
+    ('l|list'  => 'list',
+     'move' => 'move',
+     'create'=> 'create',
+     'switch-to'=> 'switch',
+     'local'=> 'local',
+     'merge'=> 'merge');
+}
+
+sub lock {} # override commit's locking
+
+sub parse_arg {
+    my ($self, @arg) = @_;
+    @arg = ('') if $#arg < 0;
+
+    return map {$self->arg_co_maybe ($_)} @arg;
+}
+
+sub run {
+    my ( $self, $target, @options ) = @_;
+
+    my $source = $target->source;
+    my $proj = SVK::Project->create_from_path(
+	$source->depot,
+	$source->path
+    );
+
+    print loc("Project mapped.  Project name: %1.\n", $proj->name);
+
+    return;
+}
+
+package SVK::Command::Branch::list;
+use base qw(SVK::Command::Branch);
+use SVK::I18N;
+
+sub run {
+    my ($self, $target) = @_;
+
+    my $source = $target->source;
+    my $proj = SVK::Project->create_from_path(
+	$source->depot,
+	$source->path
+    );
+
+    # need to beautify the output
+    use Data::Dumper;
+    warn Dumper $proj->branches() if $proj; 
+
+    print loc("Project branch listed.\n");
+    return;
+}
+
+package SVK::Command::Branch::create;
+use base qw( SVK::Command::Copy SVK::Command::Branch );
+use SVK::I18N;
+use SVK::Util qw( is_uri );
+
+sub parse_arg {
+    my ($self, @arg) = @_;
+    return if $#arg < 0;
+
+    my $dst = shift(@arg);
+    die loc ("Copy destination can't be URI.\n")
+	if is_uri ($dst);
+
+    die loc ("More than one URI found.\n")
+	if (grep {is_uri($_)} @arg) > 1;
+
+    return ($self->arg_co_maybe (''), $dst);
+}
+
+
+sub run {
+    my ($self, $target, $branch_path) = @_;
+
+    my $source = $target->source;
+    my $proj = SVK::Project->create_from_path(
+	$source->depot,
+	$source->path
+    );
+
+    my $trunk_path = '//'.$proj->depot->depotname.'/'.$proj->trunk;
+    my $newbranch_path = '//'.$proj->depot->depotname.'/'.$proj->branch_location."/".$branch_path."/";
+    # XXX if $self->{local};
+
+    my $src = $self->arg_uri_maybe($trunk_path);
+    my $dst = $self->arg_depotpath($newbranch_path);
+
+    my $ret = $self->SUPER::run($src, $dst);
+
+    if (!$ret) {
+	print loc("Project branch created: %1.\n",$branch_path);
+	# call SVK::Command::Switch ?
+	# XXX if $self->{switch};
+    }
+    return;
+}
+
+package SVK::Command::Branch::move;
+use base qw( SVK::Command::Move SVK::Command::Branch );
+use SVK::I18N;
+
+use constant narg => 1;
+
+sub run {
+    my ($self, $target) = @_;
+    print loc("nothing to move\n");
+    return;
+}
+
+package SVK::Command::Branch::merge;
+use base qw( SVK::Command::Merge SVK::Command::Branch);
+use SVK::I18N;
+
+use constant narg => 1;
+
+sub run {
+    my ($self, $target) = @_;
+    print loc("nothing to merge\n");
+    return;
+}
+
+1;
+
+__DATA__
+
+=head1 NAME
+
+SVK::Command::Branch - Initialize a mirrored depotpath
+
+=head1 SYNOPSIS
+
+ branch --create [BRANCH]
+
+ branch --list [DEPOTNAME...]
+ branch --create DEPOTPATH [http|svn]://host/path 
+ branch --move DEPOTPATH
+
+=head1 OPTIONS
+
+ -l [--list]            : list mirrored paths
+ --relocate             : change the upstream URI for the mirrored depotpath
+ --recover              : recover the state of a mirror path
+ --unlock               : forcibly remove stalled locks on a mirror
+ --upgrade              : upgrade mirror state to the latest version
+

Modified: branches/bm/lib/SVK/Project.pm
==============================================================================
--- branches/bm/lib/SVK/Project.pm	(original)
+++ branches/bm/lib/SVK/Project.pm	Wed Oct 24 05:02:33 2007
@@ -159,6 +159,7 @@
 	# trunk/branches/tags, otherwise no need to test
 	($path) = $mirror_path =~ m{^(.+(?=/(?:trunk|branches|tags)))}
 	    unless $project_name;
+	return undef unless $path;
     }
     return ($project_name, $trunk_path, $branch_path, $tag_path);
 }


More information about the svk-commit mailing list