[Bps-public-commit] r9717 - bpsbuilder/BPB/lib/BPB/Backend

[sunnavy at bestpractical.com]

Author: sunnavy
Date: Wed Nov 21 07:35:14 2007
New Revision: 9717

Modified:
   bpsbuilder/BPB/lib/BPB/Backend/SVK.pm

Log:
refactored Backend/SVK.pm, also added checkout method for it

Modified: bpsbuilder/BPB/lib/BPB/Backend/SVK.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Backend/SVK.pm	(original)
+++ bpsbuilder/BPB/lib/BPB/Backend/SVK.pm	Wed Nov 21 07:35:14 2007
@@ -17,10 +17,15 @@
     path       => {
         dependance => 'deps',
         bpb        => 'bpb',
-        project    => 'main',
+        main    => 'main',
     }
 );
 
+our %REQUIRE_OPTIONS = (
+    checkout => [qw/target/],
+    import   => [qw/source category/],
+);
+
 use base qw/Class::Accessor::Fast/;
 __PACKAGE__->mk_accessors(qw/command repository project path/);
 
@@ -41,45 +46,71 @@
 
 sub import {
     my $self = shift;
-    my %args = @_;
-
-    # category is 'project', 'dependance' or 'bpb'
-
-    for (qw/source category/) {
-        croak "need $_ option" unless $args{$_};
-    }
+    my $cmd = $self->_cmd( import => @_ );
+    $self->_run($cmd);
+}
 
-    $args{comment} ||= 'import';
+=head2 export
 
-    my $cmd = join ' ', $self->command, 'import', '-m', $args{comment},
-      $args{source}, join '/', $self->repository, $self->project,
-      $self->path->{ $args{category} };
+=cut
 
-    system($cmd );
+sub export {
+    my $self = shift;
+    my $cmd = $self->_cmd( checkout => @_, extra => ['--export'] );
+    $self->_run($cmd);
 }
 
-=head2 export
+=head2 checkout
 
 =cut
 
-sub export {
+sub checkout {
+    my $self = shift;
+    my $cmd = $self->_cmd( checkout => @_ );
+    $self->_run($cmd);
+}
+
+sub _cmd {
     my $self = shift;
+    my $type = shift;
     my %args = @_;
+    $args{extra} ||= [];
 
-    for (qw/target/) {
-        croak "need $_ option" unless $args{$_};
+    for ( @{ $REQUIRE_OPTIONS{$type} } ) {
+        croak "$type need option $_" unless $args{$_};
     }
 
-    $args{category} ||= '';   # category with '' will export the whole project
-    $args{path}     ||= '';   # path with '' will export the whole category part
+    my $cmd;
 
-    my $cmd = join ' ', $self->command, 'checkout', '--export',
-      join( '/',
-        $self->repository, $self->project,
-        $args{category} && $self->path->{ $args{category} },
-        $args{path} ),
-      $args{target};
+    if ( $type eq 'checkout' ) {
 
+        # if category is null, will checkout the whole project
+        # if path is null, will check the whole category part
+        my $path = $self->_absolute_path( $args{category}, $args{path} );
+        $cmd = join ' ', $self->command, 'checkout', $path, $args{target};
+    }
+    elsif ( $type eq 'import' ) {
+        push @{ $args{extra} }, '-m', $args{comment} || 'import';
+        my $path = $self->_absolute_path( $args{category} );
+        $cmd = join ' ', $self->command, 'import', $args{source}, $path;
+    }
+    else {
+        croak "invalid command";
+    }
+
+    return join ' ', $cmd, @{ $args{extra} };
+}
+
+sub _absolute_path {
+    my $self     = shift;
+    my $category = $self->path->{ shift @_ };
+    my @paths    = grep { $_ } $category, @_;    # trim null paths
+    return join '/', $self->repository, $self->project, @paths;
+}
+
+sub _run {
+    my $self = shift;
+    my $cmd  = shift;
     system($cmd );
 }