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

sunnavy at bestpractical.com sunnavy at bestpractical.com
Mon Aug 25 11:28:45 EDT 2008


Author: sunnavy
Date: Mon Aug 25 11:28:43 2008
New Revision: 15425

Modified:
   Shipwright/branches/1.10/lib/Shipwright/Backend/Base.pm
   Shipwright/branches/1.10/lib/Shipwright/Script/Import.pm
   Shipwright/branches/1.10/share/bin/shipwright-utility

Log:
merged 15424 to 1.1

Modified: Shipwright/branches/1.10/lib/Shipwright/Backend/Base.pm
==============================================================================
--- Shipwright/branches/1.10/lib/Shipwright/Backend/Base.pm	(original)
+++ Shipwright/branches/1.10/lib/Shipwright/Backend/Base.pm	Mon Aug 25 11:28:43 2008
@@ -221,7 +221,15 @@
     my $require = {};
 
     for (@dists) {
-        $self->_fill_deps( %args, require => $require, name => $_ );
+
+        # bloody hack, cpan-Module-Build have recommends that will
+        # cause circular deps
+        if ( $_ eq 'cpan-Module-Build' ) {
+            $require->{'cpan-Module-Build'} = [];
+        }
+        else {
+            $self->_fill_deps( %args, require => $require, name => $_ );
+        }
     }
 
     require Algorithm::Dependency::Ordered;
@@ -233,9 +241,63 @@
       or die $@;
     my $order = $dep->schedule_all();
 
+    $order = $self->fiddle_order($order);
+
     $self->order($order);
 }
 
+=item fiddle_order
+
+fiddle the order a bit
+put cpan-ExtUtils-MakeMaker and cpan-Module-Build to the head of
+cpan dists.
+also put cpan-Module-Build's recommends right after it,
+since we omitted them in the $require->{'cpan-Module-Build'}
+
+if not passed order, will use the one in shipwright/order.yml.
+return fiddled order.
+
+note, this sub won't update shipwright/order.yml, you need to do it yourself.
+
+=cut
+
+sub fiddle_order {
+    my $self       = shift;
+    my $orig_order = shift;
+
+    my $order;
+    if ($orig_order) {
+
+        # don't change the argument
+        $order = [@$orig_order];
+    }
+    else {
+        $order = $self->order;
+    }
+
+    for my $maker ( 'cpan-Module-Build', 'cpan-ExtUtils-MakeMaker' ) {
+        if ( grep { $_ eq $maker } @$order ) {
+            @$order = grep { $_ ne $maker } @$order;
+            my $first_cpan_index = firstidx { /^cpan-/ } @$order;
+            splice @$order, $first_cpan_index, 0, $maker;
+
+            if ( $maker eq 'cpan-Module-Build' ) {
+
+                # cpan-Regexp-Common is the dep of cpan-Pod-Readme
+                my @maker_recommends = (
+                    'cpan-Regexp-Common', 'cpan-Pod-Readme',
+                    'cpan-version',       'cpan-ExtUtils-CBuilder',
+                    'cpan-Archive-Tar',   'cpan-ExtUtils-ParseXS'
+                );
+                my %maker_recommends = map { $_ => 1 } @maker_recommends;
+                @$order = grep { $maker_recommends{$_} ? 0 : 1 } @$order;
+                splice @$order, $first_cpan_index + 1, 0, @maker_recommends;
+            }
+        }
+    }
+    return $order;
+}
+
 sub _fill_deps {
     my $self    = shift;
     my %args    = @_;
@@ -253,17 +315,17 @@
             push @{ $require->{$name} }, keys %{ $req->{$_} }
               if $args{"keep_$_"};
         }
-        @{ $require->{$name} } = uniq @{ $require->{$name} };
     }
     else {
 
         #for back compatbility
         push @{ $require->{$name} }, keys %$req;
     }
+    @{ $require->{$name} } = uniq @{ $require->{$name} };
 
     for my $dep ( @{ $require->{$name} } ) {
         next if $require->{$dep};
-        $self->_fill_deps( %args, name => $dep, require => $require );
+        $self->_fill_deps( %args, name => $dep );
     }
 }
 

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	Mon Aug 25 11:28:43 2008
@@ -17,7 +17,7 @@
 use File::Temp qw/tempdir/;
 use Config;
 use Hash::Merge;
-use List::MoreUtils qw/uniq firstidx/;
+use List::MoreUtils qw/firstidx/;
 
 Hash::Merge::set_behavior('RIGHT_PRECEDENT');
 
@@ -187,7 +187,8 @@
             Hash::Merge::merge( $shipwright->backend->source || {}, $new_url )
         );
 
-        $self->_reorder($shipwright);
+        my $new_order = $shipwright->backend->fiddle_order;
+        $shipwright->backend->order( $new_order );
     }
 
     print "imported with success\n";
@@ -358,50 +359,6 @@
     return catfile(@dirs);
 }
 
-# _reorder:
-# make some hack for order.
-# move ExtUtils::MakeMaker and Module::Build to the head of cpan dists
-
-sub _reorder {
-    my $self       = shift;
-    my $shipwright = shift;
-    my $order      = $shipwright->backend->order;
-
-    my $first_cpan_index = firstidx { /^cpan-/ } @$order;
-
-    unless (
-        (
-            $order->[$first_cpan_index] eq 'cpan-ExtUtils-MakeMaker'
-            && ( ( ( firstidx { $_ eq 'cpan-Module-Build' } @$order ) == -1 )
-                || $order->[ $first_cpan_index + 1 ] eq 'cpan-Module-Build' )
-        )
-        || (
-            $order->[$first_cpan_index] eq 'cpan-Module-Build'
-            && (
-                (
-                    ( firstidx { $_ eq 'cpan-ExtUtils-MakeMaker' } @$order ) ==
-                    -1
-                )
-                || $order->[ $first_cpan_index + 1 ] eq
-                'cpan-ExtUtils-MakeMaker'
-            )
-        )
-      )
-    {
-        for my $build (qw/cpan-ExtUtils-MakeMaker cpan-Module-Build/) {
-            my $index = firstidx { $build eq $_ } @$order;
-            next if $index == -1;    # $index == -1 if not found
-            if ( $index > $first_cpan_index ) {    # not the 1st cpan dist
-                splice @$order, $first_cpan_index, 0, $build;
-            }
-        }
-    }
-
-    @$order = uniq @$order;
-    $shipwright->backend->order($order);
-
-}
-
 1;
 
 __END__

Modified: Shipwright/branches/1.10/share/bin/shipwright-utility
==============================================================================
--- Shipwright/branches/1.10/share/bin/shipwright-utility	(original)
+++ Shipwright/branches/1.10/share/bin/shipwright-utility	Mon Aug 25 11:28:43 2008
@@ -4,6 +4,7 @@
 
 use Getopt::Long;
 use YAML::Syck;
+use List::MoreUtils qw/uniq firstidx/;
 
 my %args;
 
@@ -40,7 +41,7 @@
         $args{$_} = 1 unless defined $args{$_};
     }
 
-    my @dists = split /,\s*/, $args{'for-dists'};
+    my @dists = split /,\s*/, $args{'for-dists'} || '';
     unless (@dists) {
         my $out = `ls scripts`;
         my $sep = $/;
@@ -52,7 +53,15 @@
     my $require = {};
 
     for (@dists) {
-        fill_deps( %args, require => $require, dist => $_ );
+
+        # bloody hack, cpan-Module-Build have recommends that will
+        # cause circular deps
+        if ( $_ eq 'cpan-Module-Build' ) {
+            $require->{'cpan-Module-Build'} = [];
+        }
+        else {
+            fill_deps( %args, require => $require, name => $_ );
+        }
     }
 
     require Algorithm::Dependency::Ordered;
@@ -63,34 +72,64 @@
     my $dep = Algorithm::Dependency::Ordered->new( source => $source, )
       or die $@;
     my $order = $dep->schedule_all();
+
+    # fiddle the order a bit
+    # put cpan-ExtUtils-MakeMaker and cpan-Module-Build to the head of
+    # cpan dists.
+    # also put cpan-Module-Build's recommends right after it,
+    # since we omitted them in the $require->{'cpan-Module-Build'}
+
+    for my $maker ( 'cpan-Module-Build', 'cpan-ExtUtils-MakeMaker' ) {
+        if ( grep { $_ eq $maker } @$order ) {
+            @$order = grep { $_ ne $maker } @$order;
+            my $first_cpan_index = firstidx { /^cpan-/ } @$order;
+            splice @$order, $first_cpan_index, 0, $maker;
+
+            if ( $maker eq 'cpan-Module-Build' ) {
+
+                # cpan-Regexp-Common is the dep of cpan-Pod-Readme
+                my @maker_recommends = (
+                    'cpan-Regexp-Common', 'cpan-Pod-Readme',
+                    'cpan-version',       'cpan-ExtUtils-CBuilder',
+                    'cpan-Archive-Tar',   'cpan-ExtUtils-ParseXS'
+                );
+                my %maker_recommends = map { $_ => 1 } @maker_recommends;
+                @$order = grep { $maker_recommends{$_} ? 0 : 1 } @$order;
+                splice @$order, $first_cpan_index + 1, 0, @maker_recommends;
+            }
+        }
+    }
+
     DumpFile( 'shipwright/order.yml', $order );
 }
 
 sub fill_deps {
     my %args    = @_;
     my $require = $args{require};
-    my $dist    = $args{dist};
+    my $name    = $args{name};
 
     my $string;
-    my $req = LoadFile("scripts/$dist/require.yml");
+    my $req = LoadFile("scripts/$name/require.yml");
 
     if ( $req->{requires} ) {
         for (qw/requires recommends build_requires/) {
             my $arg = "keep-$_";
             $arg =~ s/_/-/g;
-            push @{ $require->{$dist} }, keys %{ $req->{$_} }
+            push @{ $require->{$name} }, keys %{ $req->{$_} }
               if $args{$arg};
         }
     }
     else {
 
         #for back compatbility
-        push @{ $require->{$dist} }, keys %$req;
+        push @{ $require->{$name} }, keys %$req;
     }
 
-    for my $dep ( @{ $require->{$dist} } ) {
+    @{ $require->{$name} } = uniq @{ $require->{$name} };
+
+    for my $dep ( @{ $require->{$name} } ) {
         next if $require->{$dep};
-        fill_deps( %args, dist => $dep );
+        fill_deps( %args, name => $dep );
     }
 }
 



More information about the Bps-public-commit mailing list