[Bps-public-commit] r15029 - in Shipwright/trunk: . lib/Shipwright/Backend lib/Shipwright/Script lib/Shipwright/Source share/bin share/shipwright t t/hello

sunnavy at bestpractical.com sunnavy at bestpractical.com
Tue Aug 12 05:04:53 EDT 2008


Author: sunnavy
Date: Tue Aug 12 05:04:44 2008
New Revision: 15029

Added:
   Shipwright/trunk/lib/Shipwright/Script/Defaultbranch.pm
   Shipwright/trunk/share/shipwright/branches.yml
Modified:
   Shipwright/trunk/   (props changed)
   Shipwright/trunk/MANIFEST
   Shipwright/trunk/lib/Shipwright/Backend/Base.pm
   Shipwright/trunk/lib/Shipwright/Backend/FS.pm
   Shipwright/trunk/lib/Shipwright/Backend/SVK.pm
   Shipwright/trunk/lib/Shipwright/Backend/SVN.pm
   Shipwright/trunk/lib/Shipwright/Build.pm
   Shipwright/trunk/lib/Shipwright/Script/Import.pm
   Shipwright/trunk/lib/Shipwright/Script/List.pm
   Shipwright/trunk/lib/Shipwright/Source.pm
   Shipwright/trunk/lib/Shipwright/Source/Base.pm
   Shipwright/trunk/lib/Shipwright/Source/Shipwright.pm
   Shipwright/trunk/lib/Shipwright/Util.pm
   Shipwright/trunk/share/bin/shipwright-builder
   Shipwright/trunk/t/21.perl_in_build.t
   Shipwright/trunk/t/71.script_cmds.t
   Shipwright/trunk/t/hello/svk.t
   Shipwright/trunk/t/hello/svn.t

Log:
merge 2.0 back to trunk

Modified: Shipwright/trunk/MANIFEST
==============================================================================
--- Shipwright/trunk/MANIFEST	(original)
+++ Shipwright/trunk/MANIFEST	Tue Aug 12 05:04:44 2008
@@ -29,6 +29,7 @@
 lib/Shipwright/Script.pm
 lib/Shipwright/Script/Build.pm
 lib/Shipwright/Script/Create.pm
+lib/Shipwright/Script/Defaultbranch.pm
 lib/Shipwright/Script/Delete.pm
 lib/Shipwright/Script/Flags.pm
 lib/Shipwright/Script/Help.pm
@@ -46,6 +47,7 @@
 lib/Shipwright/Source/Directory.pm
 lib/Shipwright/Source/FTP.pm
 lib/Shipwright/Source/HTTP.pm
+lib/Shipwright/Source/Shipwright.pm
 lib/Shipwright/Source/SVK.pm
 lib/Shipwright/Source/SVN.pm
 lib/Shipwright/Test.pm
@@ -62,6 +64,7 @@
 share/etc/shipwright-source-tcsh
 share/etc/shipwright-utility
 share/inc/YAML/Tiny.pm
+share/shipwright/branches.yml
 share/shipwright/flags.yml
 share/shipwright/known_test_failures.yml
 share/shipwright/map.yml

Modified: Shipwright/trunk/lib/Shipwright/Backend/Base.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Backend/Base.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Backend/Base.pm	Tue Aug 12 05:04:44 2008
@@ -61,7 +61,7 @@
     dircopy( Shipwright::Util->share_root, $dir );
 
     # share_root can't keep empty dirs, we have to create them manually
-    for (qw/dists scripts t/) {
+    for (qw/scripts t sources/) {
         mkdir File::Spec->catfile( $dir, $_ );
     }
 
@@ -84,13 +84,21 @@
     my $name = $args{source};
     $name =~ s{.*/}{};
 
+    if ( $args{branches} ) {
+        $args{as} = '';
+    }
+    else {
+        $args{as} ||= 'vendor';
+    }
+
     unless ( $args{_initialize} || $args{_extra_tests} ) {
         if ( $args{_extra_tests} ) {
             $self->delete( path => "/t/extra" ) if $args{delete};
 
             $self->log->info( "import extra tests to " . $self->repository );
-            Shipwright::Util->run(
-                $self->_cmd( import => %args, name => $name ) );
+            for my $cmd ( $self->_cmd( import => %args, name => $name ) ) {
+                Shipwright::Util->run($cmd);
+            }
         }
         elsif ( $args{build_script} ) {
             if ( $self->info( path => "/scripts/$name" )
@@ -105,21 +113,22 @@
 
                 $self->log->info(
                     "import $args{source}'s scripts to " . $self->repository );
-                Shipwright::Util->run(
-                    $self->_cmd( import => %args, name => $name ) );
+                for my $cmd ( $self->_cmd( import => %args, name => $name ) ) {
+                    Shipwright::Util->run($cmd);
+                }
                 $self->update_refs;
 
             }
         }
         else {
-            if ( $self->info( path => "/dists/$name" ) && not $args{overwrite} )
+            if ( $self->info( path => "/sources/$name/$args{as}" ) && not $args{overwrite} )
             {
                 $self->log->warn(
-"path dists/$name alreay exists, need to set overwrite arg to overwrite"
+"path sources/$name/$args{as} alreay exists, need to set overwrite arg to overwrite"
                 );
             }
             else {
-                $self->delete( path =>  "/dists/$name" ) if $args{delete};
+                $self->delete( path =>  "/sources/$name/$args{as}" ) if $args{delete};
                 $self->log->info(
                     "import $args{source} to " . $self->repository );
                 $self->_add_to_order($name);
@@ -128,13 +137,34 @@
                 $version->{$name} = $args{version};
                 $self->version($version);
 
-                Shipwright::Util->run(
-                    $self->_cmd( import => %args, name => $name ) );
+                my $branches = $self->branches;
+                if ( $args{branches} ) {
+            # mostly this happens when import from another shipwright repo
+                    $branches->{$name} = $args{branches};
+                    $self->branches($branches);
+                }
+                elsif (
+                    !(
+                        $branches->{$name} && grep { $args{as} eq $_ }
+                        @{ $branches->{$name} }
+                    )
+                  )
+                {
+                    $branches->{$name} =
+                      [ @{ $branches->{$name} || [] }, $args{as} ];
+                    $self->branches($branches);
+                }
+
+                for my $cmd ( $self->_cmd( import => %args, name => $name ) ) {
+                    Shipwright::Util->run($cmd);
+                }
             }
         }
     }
     else {
-        Shipwright::Util->run( $self->_cmd( import => %args, name => $name ) );
+        for my $cmd ( $self->_cmd( import => %args, name => $name ) ) {
+            Shipwright::Util->run($cmd);
+        }
     }
 }
 
@@ -149,7 +179,9 @@
     my $path = $args{path} || '';
     $self->log->info(
         'export ' . $self->repository . "/$path to $args{target}" );
-    Shipwright::Util->run( $self->_cmd( export => %args ) );
+    for my $cmd ( $self->_cmd( export => %args ) ) {
+        Shipwright::Util->run( $cmd );
+    }
 }
 
 =item checkout
@@ -162,7 +194,9 @@
     my $path = $args{path} || '';
     $self->log->info(
         'export ' . $self->repository . "/$path to $args{target}" );
-    Shipwright::Util->run( $self->_cmd( checkout => %args ) );
+    for my $cmd ( $self->_cmd( checkout => %args ) ) {
+        Shipwright::Util->run( $cmd );
+    }
 }
 
 =item commit
@@ -175,7 +209,9 @@
     my $self = shift;
     my %args = @_;
     $self->log->info( 'commit ' . $args{path} );
-    Shipwright::Util->run( $self->_cmd( commit => @_ ), 1 );
+    for my $cmd (  $self->_cmd( commit => @_ ) ) {
+        Shipwright::Util->run( $cmd, 1 );
+    }
 }
 
 
@@ -236,8 +272,8 @@
     my $name    = $args{name};
 
     return if $require->{$name};
-    my $out = Shipwright::Util->run(
-        $self->_cmd( 'cat', path => "/scripts/$name/require.yml" ), 1 );
+    my $out = Shipwright::Util->run( $self->_cmd( 'cat', path =>
+                "/scripts/$name/require.yml" ), 1 );
 
     my $req = Shipwright::Util::Load( $out ) || {};
 
@@ -343,6 +379,20 @@
     return $self->_yml( $path, $version );
 }
 
+=item branches
+
+Get or set branches.
+
+=cut
+
+sub branches {
+    my $self    = shift;
+    my $branches = shift;
+
+    my $path = '/shipwright/branches.yml';
+    return $self->_yml( $path, $branches );
+}
+
 =item ktf
 
 Get or set known failure conditions.
@@ -382,7 +432,9 @@
     my $path = $args{path} || '';
     if ( $self->info( path => $path ) ) {
         $self->log->info( "delete " . $self->repository . $path );
-        Shipwright::Util->run( $self->_cmd( delete => path => $path ), 1 );
+        for my $cmd ( $self->_cmd( delete => path => $path ) ) {
+            Shipwright::Util->run( $cmd, 1 );
+        }
     }
 }
 
@@ -425,12 +477,15 @@
     if ( $self->info( path => $path ) ) {
         $self->log->info(
             "move " . $self->repository . "/$path to /$new_path" );
-        Shipwright::Util->run(
+        for my $cmd (
             $self->_cmd(
                 move     => path => $path,
                 new_path => $new_path,
-            ),
-        );
+            )
+          )
+        {
+            Shipwright::Util->run($cmd);
+        }
     }
 }
 
@@ -556,7 +611,7 @@
     my $flags   = $self->flags   || {};
 
     for my $name (@names_to_trim) {
-        $self->delete( path => "/dists/$name" );
+        $self->delete( path => "/sources/$name" );
         $self->delete( path => "/scripts/$name" );
 
         # clean order.yml
@@ -604,8 +659,8 @@
         # initialize here, in case we don't have $name entry in $refs
         $refs->{$name} ||= 0;
 
-        my $out = Shipwright::Util->run(
-            $self->_cmd( 'cat', path => "/scripts/$name/require.yml" ), 1 );
+        my $out = Shipwright::Util->run( $self->_cmd( 'cat', path =>
+                    "/scripts/$name/require.yml"), 1 );
 
         my $req = Shipwright::Util::Load($out) || {};
 
@@ -630,6 +685,18 @@
     $self->refs( $refs );
 }
 
+=item has_branch_support
+
+return true if has branch support 
+
+=cut
+
+sub has_branch_support {
+    my $self = shift;
+    return 1 if $self->info( path => '/shipwright/branches.yml' );
+    return;
+}
+
 
 *_cmd = *_update_file = *_subclass_method;
 

Modified: Shipwright/trunk/lib/Shipwright/Backend/FS.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Backend/FS.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Backend/FS.pm	Tue Aug 12 05:04:44 2008
@@ -51,54 +51,75 @@
         croak "$type need option $_" unless $args{$_};
     }
 
-    my $cmd;
+    my @cmd;
 
     if ( $type eq 'checkout' || $type eq 'export' ) {
-        $cmd = [ 'cp', '-r', $self->repository . $args{path}, $args{target} ];
+        @cmd = [ 'cp', '-r', $self->repository . $args{path}, $args{target} ];
     }
     elsif ( $type eq 'import' ) {
         if ( $args{_extra_tests} ) {
-            $cmd = [
+            @cmd = [
                 'cp', '-r',
                 $args{source}, $self->repository . '/t/extra'
             ];
         }
         else {
             if ( my $script_dir = $args{build_script} ) {
-                $cmd = [
+                @cmd = [
                     'cp',        '-r',
                     "$script_dir/", $self->repository . "/scripts/$args{name}",
                 ];
             }
             else {
-                $cmd = [
-                    'cp',          '-r',
-                    "$args{source}/", $self->repository . "/dists/$args{name}",
-                ];
+                if ( $self->has_branch_support ) {
+                    unless ( -e $self->repository
+                        . "/sources/$args{name}/$args{as}" )
+                    {
+                        push @cmd,
+                          [
+                            'mkdir', '-p',
+                            $self->repository . "/sources/$args{name}/$args{as}"
+                          ];
+                    }
+
+                    push @cmd,
+                      [
+                        'cp', '-r', "$args{source}/",
+                        $self->repository . "/sources/$args{name}/$args{as}",
+                      ];
+                }
+                else {
+                    push @cmd,
+                      [
+                        'cp', '-r', "$args{source}/",
+                        $self->repository . "/dists/$args{name}",
+                      ];
+
+                }
             }
         }
     }
     elsif ( $type eq 'delete' ) {
-        $cmd = [ 'rm', '-rf', $self->repository . $args{path}, ];
+        @cmd = [ 'rm', '-rf', $self->repository . $args{path}, ];
     }
     elsif ( $type eq 'move' ) {
-        $cmd = [
+        @cmd = [
             'mv',
             $self->repository . $args{path},
             $self->repository . $args{new_path}
         ];
     }
     elsif ( $type eq 'info' || $type eq 'list' ) {
-        $cmd = [ 'ls', $self->repository . $args{path} ];
+        @cmd = [ 'ls', $self->repository . $args{path} ];
     }
     elsif ( $type eq 'cat' ) {
-        $cmd = [ 'cat', $self->repository . $args{path} ];
+        @cmd = [ 'cat', $self->repository . $args{path} ];
     }
     else {
         croak "invalid command: $type";
     }
 
-    return $cmd;
+    return @cmd;
 }
 
 =item _yml

Modified: Shipwright/trunk/lib/Shipwright/Backend/SVK.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Backend/SVK.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Backend/SVK.pm	Tue Aug 12 05:04:44 2008
@@ -54,72 +54,98 @@
         croak "$type need option $_" unless $args{$_};
     }
 
-    my $cmd;
+    my @cmd;
 
     if ( $type eq 'checkout' ) {
         if ( $args{detach} ) {
-            $cmd = [ 'svk', 'checkout', '-d', $args{target} ];
+            @cmd = [ 'svk', 'checkout', '-d', $args{target} ];
         }
         else {
-            $cmd = [
+            @cmd = [
                 'svk',                           'checkout',
                 $self->repository . $args{path}, $args{target}
             ];
         }
     }
     elsif ( $type eq 'export' ) {
-        $cmd =
-          [ 'svk', 'checkout', $self->repository . $args{path}, $args{target} ];
-
-        #            $cmd = [ 'svk', 'checkout', '-d', $args{target} ];
+        @cmd = (
+            [
+                'svk',                           'checkout',
+                $self->repository . $args{path}, $args{target}
+            ],
+            [
+                'svk', 'checkout', '-d', $args{target}
+            ]
+        );
     }
     elsif ( $type eq 'list' ) {
-        $cmd = [ 'svk', 'list', $self->repository . $args{path} ];
+        @cmd = [ 'svk', 'list', $self->repository . $args{path} ];
     }
     elsif ( $type eq 'import' ) {
         if ( $args{_initialize} ) {
-            $cmd = [
+            @cmd = [
                 'svk',         'import',
                 $args{source}, $self->repository,
                 '-m',          q{'} . $args{comment} . q{'},
             ];
         }
         elsif ( $args{_extra_tests} ) {
-            $cmd = [
+            @cmd = [
                 'svk', 'import',
                 $args{source}, $self->repository . '/t/extra',
                 '-m', q{'} . $args{comment} . q{'},
             ];
         }
         else {
-            if ( my $script_dir = $args{build_script} ) {
-                $cmd = [
-                    'svk',       'import',
-                    $script_dir, $self->repository . "/scripts/$args{name}/",
-                    '-m',        q{'} . $args{comment} . q{'},
-                ];
+            my ( $path, $source );
+            if ( $args{build_script} ) {
+                $path   = "/scripts/$args{name}";
+                $source = $args{build_script};
+            }
+            else {
+                $path =
+                  $self->has_branch_support
+                  ? "/sources/$args{name}/$args{as}"
+                  : "/dists/$args{name}";
+                $source = $args{source};
+            }
+
+            if ( $self->info( path => $path ) ) {
+                my $tmp_dir = tempdir( CLEANUP => 1 );
+                @cmd = (
+                    [ 'rm',  '-rf', "$tmp_dir" ],
+                    [ 'svk', 'checkout', $self->repository . $path, $tmp_dir ],
+                    [ 'rm',  '-rf', "$tmp_dir" ],
+                    [ 'cp',  '-r',  $source,                   "$tmp_dir" ],
+                    [
+                        'svk',      'commit',
+                        '--import', $tmp_dir,
+                        '-m',       q{'} . $args{comment} . q{'}
+                    ],
+                    [ 'svk', 'checkout', '-d', $tmp_dir ],
+                );
             }
             else {
-                $cmd = [
-                    'svk',         'import',
-                    $args{source}, $self->repository . "/dists/$args{name}",
-                    '-m',          q{'} . $args{comment} . q{'},
+                @cmd = [
+                    'svk',   'import',
+                    $source, $self->repository . $path,
+                    '-m',    q{'} . $args{comment} . q{'},
                 ];
             }
         }
     }
     elsif ( $type eq 'commit' ) {
-        $cmd =
+        @cmd =
           [ 'svk', 'commit', '-m', q{'} . $args{comment} . q{'}, $args{path} ];
     }
     elsif ( $type eq 'delete' ) {
-        $cmd = [
+        @cmd = [
             'svk', 'delete', '-m', q{'} . 'delete repository' . q{'},
             $self->repository . $args{path},
         ];
     }
     elsif ( $type eq 'move' ) {
-        $cmd = [
+        @cmd = [
             'svk',
             'move',
             '-m',
@@ -129,16 +155,16 @@
         ];
     }
     elsif ( $type eq 'info' ) {
-        $cmd = [ 'svk', 'info', $self->repository . $args{path} ];
+        @cmd = [ 'svk', 'info', $self->repository . $args{path} ];
     }
     elsif ( $type eq 'cat' ) {
-        $cmd = [ 'svk', 'cat', $self->repository . $args{path} ];
+        @cmd = [ 'svk', 'cat', $self->repository . $args{path} ];
     }
     else {
         croak "invalid command: $type";
     }
 
-    return $cmd;
+    return @cmd;
 }
 
 sub _yml {

Modified: Shipwright/trunk/lib/Shipwright/Backend/SVN.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Backend/SVN.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Backend/SVN.pm	Tue Aug 12 05:04:44 2008
@@ -65,26 +65,26 @@
         croak "$type need option $_" unless $args{$_};
     }
 
-    my $cmd;
+    my @cmd;
 
     if ( $type eq 'checkout' ) {
-        $cmd =
+        @cmd =
           [ 'svn', 'checkout', $self->repository . $args{path}, $args{target} ];
     }
     elsif ( $type eq 'export' ) {
-        $cmd =
+        @cmd =
           [ 'svn', 'export', $self->repository . $args{path}, $args{target} ];
     }
     elsif ( $type eq 'import' ) {
         if ( $args{_initialize} ) {
-            $cmd = [
+            @cmd = [
                 'svn',         'import',
                 $args{source}, $self->repository,
                 '-m',          q{'} . $args{comment} . q{'}
             ];
         }
         elsif ( $args{_extra_tests} ) {
-            $cmd = [
+            @cmd = [
                 'svn', 'import',
                 $args{source}, $self->repository . 't/extra',
                 '-m', q{'} . $args{comment} . q{'},
@@ -92,36 +92,52 @@
         }
         else {
             if ( my $script_dir = $args{build_script} ) {
-                $cmd = [
+                @cmd = [
                     'svn',       'import',
                     $script_dir, $self->repository . "/scripts/$args{name}/",
                     '-m',        q{'} . $args{comment} || '' . q{'},
                 ];
             }
             else {
-                $cmd = [
-                    'svn',         'import',
-                    $args{source}, $self->repository . "/dists/$args{name}",
-                    '-m',          q{'} . $args{comment} . q{'},
-                ];
+                if ( $self->has_branch_support ) {
+                    @cmd = [
+                        'svn',
+                        'import',
+                        $args{source},
+                        $self->repository . "/sources/$args{name}/$args{as}",
+                        '-m',
+                        q{'} . $args{comment} . q{'},
+                    ];
+                }
+                else {
+                    @cmd = [
+                        'svn',
+                        'import',
+                        $args{source},
+                        $self->repository . "/dists/$args{name}",
+                        '-m',
+                        q{'} . $args{comment} . q{'},
+                    ];
+
+                }
             }
         }
     }
     elsif ( $type eq 'list' ) {
-        $cmd = [ 'svn', 'list', $self->repository . $args{path} ];
+        @cmd = [ 'svn', 'list', $self->repository . $args{path} ];
     }
     elsif ( $type eq 'commit' ) {
-        $cmd =
+        @cmd =
           [ 'svn', 'commit', '-m', q{'} . $args{comment} . q{'}, $args{path} ];
     }
     elsif ( $type eq 'delete' ) {
-        $cmd = [
+        @cmd = [
             'svn', 'delete', '-m', q{'} . 'delete' . $args{path} . q{'},
             $self->repository . $args{path}
         ];
     }
     elsif ( $type eq 'move' ) {
-        $cmd = [
+        @cmd = [
             'svn',
             'move',
             '-m',
@@ -131,16 +147,16 @@
         ];
     }
     elsif ( $type eq 'info' ) {
-        $cmd = [ 'svn', 'info', $self->repository . $args{path} ];
+        @cmd = [ 'svn', 'info', $self->repository . $args{path} ];
     }
     elsif ( $type eq 'cat' ) {
-        $cmd = [ 'svn', 'cat', $self->repository . $args{path} ];
+        @cmd = [ 'svn', 'cat', $self->repository . $args{path} ];
     }
     else {
         croak "invalid command: $type";
     }
 
-    return $cmd;
+    return @cmd;
 }
 
 sub _yml {

Modified: Shipwright/trunk/lib/Shipwright/Build.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Build.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Build.pm	Tue Aug 12 05:04:44 2008
@@ -116,7 +116,7 @@
             File::Spec->catfile( 'shipwright', 'order.yml' ) )
           || [];
 
-        my ( $flags, $ktf );
+        my ( $flags, $ktf, $branches );
         if ( -e File::Spec->catfile( 'shipwright', 'flags.yml' ) ) {
 
             $flags = Shipwright::Util::LoadFile(
@@ -144,6 +144,12 @@
             $ktf = {};
         }
 
+        if ( -e File::Spec->catfile( 'shipwright', 'branches.yml' ) ) {
+
+            $branches = Shipwright::Util::LoadFile(
+                File::Spec->catfile( 'shipwright', 'branches.yml' ) );
+        }
+
         # calculate the real order
         if ( $self->only ) {
             @$order = grep { $self->only->{$_} } @$order;
@@ -176,8 +182,9 @@
             }
         }
 
+        mkdir 'dists' unless -e 'dists';
         for my $dist (@$order) {
-            $self->_install( $dist, $ktf );
+            $self->_install( $dist, $ktf, $branches );
             $self->_record($dist);
             chdir $self->build_base;
         }
@@ -196,6 +203,19 @@
     my $self = shift;
     my $dir  = shift;
     my $ktf  = shift;
+    my $branches = shift;
+
+    if ( $branches ) {
+            system(
+                "cp -r "
+                  . File::Spec->catdir( 'sources', $dir, split /\//,
+                    $branches->{$dir}[0] )
+                  . ' '
+                  . File::Spec->catdir( 'dists', $dir )
+              )
+              && die
+              "cp sources/$dir/$branches->{$dir}[0] to dists/$dir failed";
+    }
 
     chdir File::Spec->catfile( 'dists', $dir );
 

Added: Shipwright/trunk/lib/Shipwright/Script/Defaultbranch.pm
==============================================================================
--- (empty file)
+++ Shipwright/trunk/lib/Shipwright/Script/Defaultbranch.pm	Tue Aug 12 05:04:44 2008
@@ -0,0 +1,56 @@
+package Shipwright::Script::Defaultbranch;
+use strict;
+use warnings;
+use Carp;
+
+use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
+
+use Shipwright;
+
+sub run {
+    my $self    = shift;
+    my $name    = shift;
+    my $default = shift;
+
+    die "need name arg\n" unless $name;
+    die "need default arg\n" unless $default;
+
+    my $shipwright = Shipwright->new( repository => $self->repository, );
+
+    my $branches = $shipwright->backend->branches;
+
+    if ( grep { $default eq $_ } @{ $branches->{$name} } ) {
+
+        # move $default to head
+        @{ $branches->{$name} } =
+          ( $default, grep { $_ ne $default } @{ $branches->{$name} } );
+        $shipwright->backend->branches( $branches );
+        print "set default branch for $name with success, now it's $default\n";
+    }
+    else {
+        die "$name doesn't have branches $default.
+Available branches are " . join( ', ', @{$branches->{$name}} ). "\n";
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Shipwright::Script::Defaultbranch - set the default branch for a dist
+
+=head1 SYNOPSIS
+
+ defaultbranch -r ... DIST BRANCH
+
+=head1 OPTIONS
+
+ -r [--repository] REPOSITORY   : specify the repository of our project
+ -l [--log-level] LOGLEVEL      : specify the log level
+                                  (info, debug, warn, error, or fatal)
+ --log-file FILENAME            : specify the log file
+
+=head1 DESCRIPTION
+

Modified: Shipwright/trunk/lib/Shipwright/Script/Import.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Import.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Script/Import.pm	Tue Aug 12 05:04:44 2008
@@ -7,7 +7,7 @@
 use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
 __PACKAGE__->mk_accessors(
     qw/comment no_follow build_script require_yml
-      name test_script extra_tests overwrite min_perl_version skip version/
+      name test_script extra_tests overwrite min_perl_version skip version as/
 );
 
 use Shipwright;
@@ -34,6 +34,7 @@
         'min-perl-version' => 'min_perl_version',
         'skip=s'           => 'skip',
         'version=s'        => 'version',
+        'as=s'             => 'as',
     );
 }
 
@@ -136,6 +137,7 @@
             $script_dir = File::Spec->catdir( $base, '__scripts', $name );
         }
         else {
+
      # Source part doesn't have script stuff, so we need to create by ourselves.
             $script_dir = tempdir( CLEANUP => 1 );
 
@@ -160,12 +162,18 @@
             }
         }
 
+        my $branches =
+          Shipwright::Util::LoadFile( $shipwright->source->branches_path );
+
         $shipwright->backend->import(
             source  => $source,
             comment => $self->comment || 'import ' . $source,
-            overwrite => 1,                   # import anyway for the main dist
+            overwrite => 1,                    # import anyway for the main dist
             version   => $version->{$name},
+            as        => $self->as,
+            branches  => $branches->{$name},
         );
+
         $shipwright->backend->import(
             source       => $source,
             comment      => 'import scripts for' . $source,
@@ -197,10 +205,10 @@
 # _import_req: import required dists for a dist
 
 sub _import_req {
-    my $self         = shift;
-    my $source       = shift;
-    my $shipwright   = shift;
-    my $script_dir   = shift;
+    my $self       = shift;
+    my $source     = shift;
+    my $shipwright = shift;
+    my $script_dir = shift;
 
     my $require_file = File::Spec->catfile( $source, '__require.yml' );
     $require_file = File::Spec->catfile( $script_dir, 'require.yml' )
@@ -261,11 +269,14 @@
 
                     $self->_import_req( $s, $shipwright, $script_dir );
 
+                    my $branches = Shipwright::Util::LoadFile(
+                        $shipwright->source->branches_path );
                     $shipwright->backend->import(
                         comment   => 'deps for ' . $source,
                         source    => $s,
                         overwrite => $self->overwrite,
                         version   => $version->{$dist},
+                        branches  => $branches->{$dist},
                     );
                     $shipwright->backend->import(
                         source       => $s,

Modified: Shipwright/trunk/lib/Shipwright/Script/List.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/List.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Script/List.pm	Tue Aug 12 05:04:44 2008
@@ -28,6 +28,11 @@
     my $versions = $shipwright->backend->version;
     my $source   = $shipwright->backend->source;
     my $refs = $shipwright->backend->refs || {};
+    my $branches;
+
+    if ( $shipwright->backend->has_branch_support ) {
+        $branches = $shipwright->backend->branches;
+    }
 
     my $latest_version = {};
 
@@ -38,7 +43,7 @@
         my $map = $shipwright->backend->map;
 
         if ( $name ) {
-            if ( $name =~ /^cpan-/ ) {
+            if ( $name =~ /^cpan-/ && ! $source->{$name} ) {
                 my %reversed = reverse %$map;
                 my $module   = $reversed{ $name };
                 $latest_version->{ $name } =
@@ -59,7 +64,7 @@
 
             for my $name ( keys %$source ) {
                 next if exists $latest_version->{$name};
-                if ( $source->{$name} =~ m{^sv[nk]:} ) {
+                if ( $source->{$name} =~ m{^(sv[nk]|shipwright):} ) {
                     $latest_version->{$name} =
                       $self->_latest_version( url => $source->{$name} );
                 }
@@ -98,6 +103,10 @@
                 print ' ' x 4 . 'latest_version: ', $latest_version->{$name}
                   || 'unknown', "\n";
             }
+            if ($branches) {
+                print ' ' x 4 . 'branches: ',
+                  join( ', ', @{ $branches->{$name} } ), "\n";
+            }
         }
     }
 
@@ -113,6 +122,11 @@
 
         my ( $cmd, $out );
 
+# XXX TODO we need a better latest_version for shipwright source
+# using the source shipwright repo's whole version seems lame
+        $args{url} =~ s/^shipwright://;
+        $args{url} =~ s!/[^/]+$!!;
+
         # has url, meaning svn or svk
         if ( $args{url} =~ /^svn[:+]/ ) {
             $args{url} =~ s{^svn:(?!//)}{};

Modified: Shipwright/trunk/lib/Shipwright/Source.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Source.pm	Tue Aug 12 05:04:44 2008
@@ -20,8 +20,10 @@
 $DEFAULT{url_path} = File::Spec->catfile( $DEFAULT{directory}, 'url.yml' );
 $DEFAULT{version_path} =
   File::Spec->catfile( $DEFAULT{directory}, 'version.yml' );
+$DEFAULT{branches_path} =
+  File::Spec->catfile( $DEFAULT{directory}, 'branches.yml' );
 
-for (qw/map_path url_path version_path/) {
+for (qw/map_path url_path version_path branches_path/) {
     open my $fh, '>', $DEFAULT{$_} or die "can't write to $DEFAULT{$_}: $!";
     close $fh;
 }

Modified: Shipwright/trunk/lib/Shipwright/Source/Base.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/Base.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Source/Base.pm	Tue Aug 12 05:04:44 2008
@@ -14,7 +14,7 @@
 __PACKAGE__->mk_accessors(
     qw/source directory scripts_directory download_directory follow 
     min_perl_version map_path skip map keep_recommends keep_build_requires 
-    name log url_path version_path version/
+    name log url_path version_path branches_path version/
 );
 
 =head1 NAME
@@ -394,6 +394,19 @@
     Shipwright::Util::DumpFile( $self->version_path, $map );
 }
 
+sub _update_branches {
+    my $self    = shift;
+    my $name    = shift;
+    my $branches = shift;
+
+    my $map = {};
+    if ( -e $self->version_path && !-z $self->branches_path ) {
+        $map = Shipwright::Util::LoadFile( $self->branches_path );
+    }
+    $map->{$name} = $branches;
+    Shipwright::Util::DumpFile( $self->branches_path, $map );
+}
+
 sub _is_skipped {
     my $self   = shift;
     my $module = shift;

Modified: Shipwright/trunk/lib/Shipwright/Source/Shipwright.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/Shipwright.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Source/Shipwright.pm	Tue Aug 12 05:04:44 2008
@@ -20,10 +20,18 @@
     my $source_shipwright = Shipwright->new( repository => $base );
     $self->name( $dist ) unless $self->name;
 
-    $source_shipwright->backend->export(
-        target => File::Spec->catfile( $self->directory, $self->name ),
-        path   => "/dists/$dist",
-    );
+    if ( $source_shipwright->backend->has_branch_support ) {
+        $source_shipwright->backend->export(
+            target => File::Spec->catfile( $self->directory, $self->name ),
+            path   => "/sources/$dist",
+        );
+    }
+    else {
+        $source_shipwright->backend->export(
+            target => File::Spec->catfile( $self->directory, $self->name ),
+            path   => "/dists/$dist",
+        );
+    }
 
     $source_shipwright->backend->export(
         target => File::Spec->catfile( $self->scripts_directory, $self->name ),
@@ -31,14 +39,17 @@
     );
     
     my $source_version = $source_shipwright->backend->version->{$dist};
+    my $branches = $source_shipwright->backend->branches;
     $self->_update_version( $self->name || $dist, $source_version );
-    $self->_update_url( $self->name || $dist, $self->source );
+    $self->_update_url( $self->name || $dist, 'shipwright:' . $self->source );
+    $self->_update_branches( $self->name || $dist, $branches->{$dist} );
 
 # follow
     if ( $self->follow ) {
         my $out = Shipwright::Util->run(
             $source_shipwright->backend->_cmd(
-                'cat', path => "/scripts/$dist/require.yml"
+                'cat',
+                path => "/scripts/$dist/require.yml",
             ),
             1
         );

Modified: Shipwright/trunk/lib/Shipwright/Util.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Util.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Util.pm	Tue Aug 12 05:04:44 2008
@@ -61,13 +61,18 @@
     Shipwright::Util->select('stdout');
 
     $log->info("run output:\n$out") if $out;
-    $log->warn("run err:\n$err")    if $err;
+    $log->error("run err:\n$err")    if $err;
 
     if ($?) {
         $log->error(
             'failed to run ' . join( ' ', @$cmd ) . " with exit number $?" );
-
-        die "something wrong when execute @$cmd: $?" unless $ignore_failure;
+        unless ($ignore_failure) {
+            die <<"EOF";
+something wrong when execute @$cmd: $?
+the output is: $out
+the error is: $err
+EOF
+        }
     }
 
     return wantarray ? ( $out, $err ) : $out;

Modified: Shipwright/trunk/share/bin/shipwright-builder
==============================================================================
--- Shipwright/trunk/share/bin/shipwright-builder	(original)
+++ Shipwright/trunk/share/bin/shipwright-builder	Tue Aug 12 05:04:44 2008
@@ -132,7 +132,7 @@
 my $order =
   ( YAML::Tiny->read( File::Spec->catfile( 'shipwright', 'order.yml' ) ) )->[0];
 
-my ( $flags, $ktf );
+my ( $flags, $ktf, $branches );
 
 if ( -e File::Spec->catfile( 'shipwright', 'flags.yml' ) ) {
     $flags =
@@ -154,6 +154,14 @@
     $ktf = {};
 }
 
+if ( -e File::Spec->catfile( 'shipwright', 'branches.yml' ) ) {
+    $branches = (
+        YAML::Tiny->read(
+            File::Spec->catfile( 'shipwright', 'branches.yml' )
+        )
+    )->[0];
+}
+
 # fill not specified but mandatory flags
 if ( $flags->{__mandatory} ) {
     for my $list ( values %{ $flags->{__mandatory} } ) {
@@ -189,12 +197,17 @@
     open $log, '>', 'clean.log' or die $!;
 
     system('rm -rf tmp_dists') && die "rm tmp_dists failed\n";
-
     print $log "removed tmp_dists";
 
-    for my $dist (@$order) {
-        clean($dist);
-        chdir $build_base;
+    if ($branches) {
+        system('rm -rf dists') && die "rm dists failed\n";
+        print $log "removed dists";
+    }
+    else {
+        for my $dist (@$order) {
+            clean($dist);
+            chdir $build_base;
+        }
     }
 
     unlink '__need_clean';
@@ -294,6 +307,7 @@
       File::Spec->catfile( $args{'install-base'}, 'tools',
         'shipwright-utility' );
 
+    mkdir 'dists' unless -e 'dists';
     for my $dist (@$order) {
         install($dist);
         record($dist);
@@ -315,7 +329,18 @@
         chdir File::Spec->catfile( 'tmp_dists', $dir );
     }
     else {
-        chdir File::Spec->catfile( 'dists', $dir );
+        if ($branches) {
+            system(
+                "cp -r "
+                  . File::Spec->catdir( 'sources', $dir, split /\//,
+                    $branches->{$dir}[0] )
+                  . ' '
+                  . File::Spec->catdir( 'dists', $dir )
+              )
+              && die
+              "cp sources/$dir/$branches->{$dir}[0] to dists/$dir failed";
+        }
+        chdir File::Spec->catdir( 'dists', $dir );
     }
 
     my $skip_test = $args{'skip-test'} || $args{'skip-test-except-final'};

Added: Shipwright/trunk/share/shipwright/branches.yml
==============================================================================
--- (empty file)
+++ Shipwright/trunk/share/shipwright/branches.yml	Tue Aug 12 05:04:44 2008
@@ -0,0 +1 @@
+---

Modified: Shipwright/trunk/t/21.perl_in_build.t
==============================================================================
--- Shipwright/trunk/t/21.perl_in_build.t	(original)
+++ Shipwright/trunk/t/21.perl_in_build.t	Tue Aug 12 05:04:44 2008
@@ -66,7 +66,6 @@
         build_script => $script_dir,
     );
     $sw->backend->export( target => $sw->build->build_base );
-    $sw->build->build_base;
     $sw->build->run;
     is( $sw->build->perl, $perl,
 'set $build->perl to the one that will be in installed_dir if there is a dist with name perl'

Modified: Shipwright/trunk/t/71.script_cmds.t
==============================================================================
--- Shipwright/trunk/t/71.script_cmds.t	(original)
+++ Shipwright/trunk/t/71.script_cmds.t	Tue Aug 12 05:04:44 2008
@@ -280,7 +280,7 @@
                 [ 'list', 'foo' ],
                 $update_cmd
                 ? qr/version:\s+1\s+/
-                : qr/version:\s+55\s+/m, # the magic number is from practice ;)
+                : qr/version:\s+57\s+/m, # the magic number is from practice ;)
                 'list foo, version seems ok',
             ],
             $update_cmd,    # if the source dist is svk, $update_cmd is undef
@@ -288,7 +288,7 @@
                 [ 'list', 'foo', '--with-latest-version' ],
                 $update_cmd
                 ? qr/latest_version:\s+([^1]|\d{2,})\s+/
-                : qr/latest_version:\s+(?!55)\d+\s+/,
+                : qr/latest_version:\s+(?!57)\d+\s+/,
                 'list foo, latest version seems ok',
             ],
 

Modified: Shipwright/trunk/t/hello/svk.t
==============================================================================
--- Shipwright/trunk/t/hello/svk.t	(original)
+++ Shipwright/trunk/t/hello/svk.t	Tue Aug 12 05:04:44 2008
@@ -62,7 +62,7 @@
     chomp @dirs;
     is_deeply(
         [@dirs],
-        [ 'bin/', 'dists/', 'etc/', 'inc/', 'scripts/', 'shipwright/', 't/' ],
+        [ 'bin/', 'etc/', 'inc/', 'scripts/', 'shipwright/', 'sources/', 't/' ],
         'initialize works'
     );
 
@@ -82,7 +82,8 @@
     # import
 
     $shipwright->backend->import( name => 'hello', source => $source_dir );
-    ok( grep( {/Build\.PL/} `svk ls $repo/dists/Acme-Hello` ), 'imported ok' );
+    ok( grep( {/Build\.PL/} `svk ls $repo/sources/Acme-Hello/vendor` ),
+        'imported ok' );
 
     my $script_dir = tempdir( CLEANUP => 1 );
     copy( File::Spec->catfile( 't', 'hello', 'scripts', 'build' ),
@@ -111,12 +112,13 @@
             'shipwright-script-wrapper'
         ),
         File::Spec->catfile(
-            $shipwright->build->build_base,
-            'dists', 'Acme-Hello',
+            $shipwright->build->build_base, 'sources',
+            'Acme-Hello',                   'vendor',
         ),
         File::Spec->catfile(
-            $shipwright->build->build_base, 'dists',
-            'Acme-Hello',                   'MANIFEST',
+            $shipwright->build->build_base, 'sources',
+            'Acme-Hello',                   'vendor',
+            'MANIFEST',
         ),
         File::Spec->catfile(
             $shipwright->build->build_base, 'scripts',
@@ -144,16 +146,18 @@
     chdir $cwd;
     $shipwright = Shipwright->new(
         repository => "svk:$repo",
-        source => 'file:' . File::Spec->catfile( 't', 'hello', 'Acme-Hello-0.03.tar.gz' ),
-        name   => 'howdy',
-        follow => 0,
+        source     => 'file:'
+          . File::Spec->catfile( 't', 'hello', 'Acme-Hello-0.03.tar.gz' ),
+        name      => 'howdy',
+        follow    => 0,
         log_level => 'FATAL',
     );
 
     $source_dir = $shipwright->source->run();
     like( $source_dir, qr/\bhowdy\b/, 'source name looks ok' );
     $shipwright->backend->import( name => 'hello', source => $source_dir );
-    ok( grep( {/Build\.PL/} `svk ls $repo/dists/howdy` ), 'imported ok' );
+    ok( grep( {/Build\.PL/} `svk ls $repo/sources/howdy/vendor` ),
+        'imported ok' );
     $script_dir = tempdir( CLEANUP => 1 );
     copy( File::Spec->catfile( 't', 'hello', 'scripts', 'build' ),
         $script_dir );

Modified: Shipwright/trunk/t/hello/svn.t
==============================================================================
--- Shipwright/trunk/t/hello/svn.t	(original)
+++ Shipwright/trunk/t/hello/svn.t	Tue Aug 12 05:04:44 2008
@@ -34,7 +34,7 @@
     chomp @dirs;
     is_deeply(
         [@dirs],
-        [ 'bin/', 'dists/', 'etc/', 'inc/', 'scripts/', 'shipwright/', 't/' ],
+        [ 'bin/', 'etc/', 'inc/', 'scripts/', 'shipwright/', 'sources/', 't/' ],
         'initialize works'
     );
 
@@ -43,7 +43,8 @@
 
     # import
     $shipwright->backend->import( name => 'hello', source => $source_dir );
-    ok( grep( {/Build\.PL/} `svn ls $repo/dists/Acme-Hello` ), 'imported ok' );
+    ok( grep( {/Build\.PL/} `svn ls $repo/sources/Acme-Hello/vendor` ),
+        'imported ok' );
 
     my $script_dir = tempdir( CLEANUP => 1 );
     copy( File::Spec->catfile( 't', 'hello', 'scripts', 'build' ),
@@ -73,12 +74,13 @@
             'shipwright-script-wrapper'
         ),
         File::Spec->catfile(
-            $shipwright->build->build_base,
-            'dists', 'Acme-Hello',
+            $shipwright->build->build_base, 'sources',
+            'Acme-Hello',                   'vendor',
         ),
         File::Spec->catfile(
-            $shipwright->build->build_base, 'dists',
-            'Acme-Hello',                   'MANIFEST',
+            $shipwright->build->build_base, 'sources',
+            'Acme-Hello',                   'vendor',
+            'MANIFEST',
         ),
         File::Spec->catfile(
             $shipwright->build->build_base, 'scripts',
@@ -116,7 +118,8 @@
     $source_dir = $shipwright->source->run();
     like( $source_dir, qr/\bhowdy\b/, 'source name looks ok' );
     $shipwright->backend->import( name => 'hello', source => $source_dir );
-    ok( grep( {/Build\.PL/} `svn ls $repo/dists/howdy` ), 'imported ok' );
+    ok( grep( {/Build\.PL/} `svn ls $repo/sources/howdy/vendor` ),
+        'imported ok' );
     $script_dir = tempdir( CLEANUP => 1 );
     copy( File::Spec->catfile( 't', 'hello', 'scripts', 'build' ),
         $script_dir );



More information about the Bps-public-commit mailing list