[Bps-public-commit] r16194 - in Shipwright/branches/1.10/lib/Shipwright: Script

[sunnavy at bestpractical.com]

Author: sunnavy
Date: Thu Oct  2 07:28:27 2008
New Revision: 16194

Modified:
   Shipwright/branches/1.10/lib/Shipwright/Script/Import.pm
   Shipwright/branches/1.10/lib/Shipwright/Source/Base.pm

Log:
merged 16192:16193 to 1.1

Modified: Shipwright/branches/1.10/lib/Shipwright/Script/Import.pm
==============================================================================
--- Shipwright/branches/1.10/lib/Shipwright/Script/Import.pm	(original)
+++ Shipwright/branches/1.10/lib/Shipwright/Script/Import.pm	Thu Oct  2 07:28:27 2008
@@ -7,7 +7,8 @@
 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
+      skip_recommends skip_all_recommends/
 );
 
 use Shipwright;
@@ -23,17 +24,19 @@
 
 sub options {
     (
-        'm|comment=s'      => 'comment',
-        'name=s'           => 'name',
-        'no-follow'        => 'no_follow',
-        'build-script=s'   => 'build_script',
-        'require-yml=s'    => 'require_yml',
-        'test-script'      => 'test_script',
-        'extra-tests'      => 'extra_tests',
-        'overwrite'        => 'overwrite',
-        'min-perl-version' => 'min_perl_version',
-        'skip=s'           => 'skip',
-        'version=s'        => 'version',
+        'm|comment=s'         => 'comment',
+        'name=s'              => 'name',
+        'no-follow'           => 'no_follow',
+        'build-script=s'      => 'build_script',
+        'require-yml=s'       => 'require_yml',
+        'test-script'         => 'test_script',
+        'extra-tests'         => 'extra_tests',
+        'overwrite'           => 'overwrite',
+        'min-perl-version'    => 'min_perl_version',
+        'skip=s'              => 'skip',
+        'version=s'           => 'version',
+        'skip-recommends=s'   => 'skip_recommends',
+        'skip-all-recommends' => 'skip_all_recommends',
     );
 }
 
@@ -75,6 +78,8 @@
     }
     else {
         $self->skip( { map { $_ => 1 } split /\s*,\s*/, $self->skip || '' } );
+        $self->skip_recommends(
+            { map { $_ => 1 } split /\s*,\s*/, $self->skip_recommends || '' } );
 
         if ( $self->name ) {
             if ( $self->name =~ /::/ ) {
@@ -91,13 +96,15 @@
         }
 
         my $shipwright = Shipwright->new(
-            repository       => $self->repository,
-            source           => $source,
-            name             => $self->name,
-            follow           => !$self->no_follow,
-            min_perl_version => $self->min_perl_version,
-            skip             => $self->skip,
-            version          => $self->version,
+            repository          => $self->repository,
+            source              => $source,
+            name                => $self->name,
+            follow              => !$self->no_follow,
+            min_perl_version    => $self->min_perl_version,
+            skip                => $self->skip,
+            version             => $self->version,
+            skip_recommends     => $self->skip_recommends,
+            skip_all_recommends => $self->skip_all_recommends,
         );
 
         unless ( $self->overwrite ) {
@@ -188,7 +195,7 @@
         );
 
         my $new_order = $shipwright->backend->fiddle_order;
-        $shipwright->backend->order( $new_order );
+        $shipwright->backend->order($new_order);
     }
 
     print "imported with success\n";
@@ -391,6 +398,11 @@
                                   are already in the repository
  --version                      : specify the source's version
 
+ --skip-recommends              : specify a list of modules/dist names of
+                                  which recommends we don't want to import
+
+ --skip-all-recommends          : skip all the recommends to import
+
 =head1 DESCRIPTION
 
 The import command imports a new dist into a shipwright repository from any of

Modified: Shipwright/branches/1.10/lib/Shipwright/Source/Base.pm
==============================================================================
--- Shipwright/branches/1.10/lib/Shipwright/Source/Base.pm	(original)
+++ Shipwright/branches/1.10/lib/Shipwright/Source/Base.pm	Thu Oct  2 07:28:27 2008
@@ -13,8 +13,9 @@
 use base qw/Class::Accessor::Fast/;
 __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/
+      min_perl_version map_path skip skip_recommends skip_all_recommends
+      map keep_recommends keep_build_requires name log url_path version_path 
+      version/
 );
 
 =head1 NAME
@@ -66,6 +67,7 @@
     my $map          = {};
     my $url          = {};
 
+
     unless ( $self->min_perl_version ) {
         no warnings 'once';
         require Config;
@@ -82,6 +84,14 @@
         $url = Shipwright::Util::LoadFile( $self->url_path );
     }
 
+    my @types = qw/requires build_requires/;
+
+    my $reverse_map = { reverse %$map };
+    my $skip_recommends = $self->skip_recommends->{ $self->name }
+      || $self->skip_recommends->{ $reverse_map->{ $self->name } }
+      || $self->skip_all_recommends;
+    push @types, 'recommends' unless $skip_recommends;
+
     if ( !-e $require_path ) {
 
         # if not found, we'll create one according to Build.PL or Makefile.PL
@@ -235,7 +245,7 @@
             Shipwright::Util->run( [ 'rm',   'Makefile.old' ] );
         }
 
-        for my $type (qw/requires recommends build_requires/) {
+        for my $type ( @types ) {
             for my $module ( keys %{ $require->{$type} } ) {
                 $require->{$type}{$module}{version} =
                   delete $require->{$type}{$module};
@@ -257,7 +267,7 @@
             }
         }
 
-        for my $type (qw/requires recommends build_requires/) {
+        for my $type ( @types ) {
             for my $module ( keys %{ $require->{$type} } ) {
 
 #the name shouldn't be undefined, but it _indeed_ happens in reality sometimes
@@ -362,6 +372,9 @@
                 }
             }
         }
+        # don't keep recommends info if we skip them, so we won't encounter
+        # them when update later
+        $require->{recommends} = {} if $skip_recommends;
 
         Shipwright::Util::DumpFile( $require_path, $require );
     }