[Bps-public-commit] r10428 - bpsbuilder/Shipwright/lib/Shipwright/Source

sunnavy at bestpractical.com sunnavy at bestpractical.com
Tue Jan 22 13:17:32 EST 2008


Author: sunnavy
Date: Tue Jan 22 13:17:31 2008
New Revision: 10428

Modified:
   bpsbuilder/Shipwright/lib/Shipwright/Source/Base.pm

Log:
find dependences logic, it's more safe to get deps from Build.PL or Makefile.PL

Modified: bpsbuilder/Shipwright/lib/Shipwright/Source/Base.pm
==============================================================================
--- bpsbuilder/Shipwright/lib/Shipwright/Source/Base.pm	(original)
+++ bpsbuilder/Shipwright/lib/Shipwright/Source/Base.pm	Tue Jan 22 13:17:31 2008
@@ -4,6 +4,7 @@
 use strict;
 use Carp;
 use File::Spec;
+use File::Slurp;
 use Module::CoreList;
 use Shipwright::Source;
 use Shipwright::Config;
@@ -48,46 +49,74 @@
         $map = Shipwright::Config::LoadFile( $self->map_path );
     }
 
-    # if not found, we'll create one according to META.yml
     if ( !-e $require_path ) {
-        my $meta_path = File::Spec->catfile( $path, 'META.yml' );
+
+        # if not found, we'll create one according to Build.PL or Makefile.PL
         my $require = {};
-        if ( -e $meta_path ) {
-            my $meta = Shipwright::Config::LoadFile($meta_path);
+        chdir File::Spec->catfile($path);
 
-            for my $module ( keys %{ $meta->{requires} } ) {
-                $require->{requires}{$module}{version} =
-                  $meta->{requires}{$module};
-            }
+        if ( -e 'Build.PL' ) {
+            Shipwright::Util->run( [ $^X, 'Build.PL' ] );
+            my $source =
+              read_file( File::Spec->catfile( '_build', 'prereqs' ) );
+            my $eval .= '$require = ' . $source;
+            eval $eval or die "eval error: $@";
 
-            if ( $self->keep_recommends && $meta->{recommends} ) {
-                for my $module ( keys %{ $meta->{recommends} } ) {
-                    $require->{recommends}{$module}{version} =
-                      $meta->{recommends}{$module};
-                }
+            unless ( $require->{build_requires}{'Module::Build'} ) {
+                $require->{build_requires} = { 'Module::Build' => 0 };
+            }
+            Shipwright::Util->run( [ './Build', 'realclean' ] );
+        }
+        elsif ( -e 'Makefile.PL' ) {
+            Shipwright::Util->run( [ $^X, 'Makefile.PL' ] );
+            my ($source) = grep { /PREREQ_PM/ } read_file('Makefile');
+            if ( $source =~ /({.*})/ ) {
+                my $eval .= '$require = ' . $1;
+                $eval =~ s/([\w:]+)=>/'$1'=>/g;
+                eval $eval or die "eval error: $@";
+            }
+            for ( keys %$require ) {
+                $require->{requires}{$_} = delete $require->{$_};
             }
 
-            if ( $self->keep_build_requires && $meta->{build_requires} ) {
-                for my $module ( keys %{ $meta->{build_requires} } ) {
-                    $require->{build_requires}{$module}{version} =
-                      $meta->{build_requires}{$module};
+      # Makefile doesn't have recommends or build_requires stuff, we need to fix
+      # that accroding to META.yml
+            my $meta_path = File::Spec->catfile( $path, 'META.yml' );
+            if ( -e $meta_path ) {
+                my $meta = Shipwright::Config::LoadFile($meta_path);
+
+                for (qw/recommends build_requires/) {
+                    my $keep = 'keep_' . $_;
+                    no strict 'refs';
+                    if ( $meta->{$_} ) {
+                        for my $module ( keys %{ $meta->{$_} } ) {
+                            next unless defined $require->{requires}{$module};
+                            my $version = delete
+                                $require->{requires}{$module};
+                            $require->{$_}{$module} = $version
+                              if $self->$keep;
+                        }
+                    }
                 }
             }
+
+            Shipwright::Util->run( [ 'rm', 'Makefile' ] );
         }
 
-        if ( -e File::Spec->catfile( $path, 'Build.PL' )
-            && !$require->{build_requires}{'Module::Build'} )
-        {
-            $require->{build_requires} =
-              { 'Module::Build' => { version => 0 } };
+        for my $type (qw/requires recommends build_requires/) {
+            for my $module ( keys %{ $require->{$type} } ) {
+                $require->{$type}{$module}{version} =
+                  delete $require->{$type}{$module};
+            }
         }
 
         Shipwright::Config::DumpFile( $require_path, $require );
     }
 
     if ( my $require = Shipwright::Config::LoadFile($require_path) ) {
-# if not have 'requires' key, all the keys in $require are supposed to be
-# requires type
+
+       # if not have 'requires' key, all the keys in $require are supposed to be
+       # requires type
         if ( !$require->{requires} ) {
             for my $module ( keys %$require ) {
                 $require->{requires}{$module}{version} =
@@ -96,6 +125,7 @@
         }
         for my $type (qw/requires recommends build_requires/) {
             for my $module ( keys %{ $require->{$type} } ) {
+
                 # we don't want to require perl
                 if ( $module eq 'perl' ) {
                     delete $require->{$type}{$module};
@@ -210,8 +240,10 @@
             my $cmd = [
                 'cp',
                 $file{$_},
-                File::Spec->catfile( $self->directory,
-                    $self->name || $self->just_name( $self->path ), $_ )
+                File::Spec->catfile(
+                    $self->directory,
+                    $self->name || $self->just_name( $self->path ), $_
+                )
             ];
             Shipwright::Util->run($cmd);
         }
@@ -228,7 +260,7 @@
     my $self = shift;
     my $name = shift;
     require CPAN::DistnameInfo;
-    return CPAN::DistnameInfo->new( "$name.tar.gz" )->dist;
+    return CPAN::DistnameInfo->new("$name.tar.gz")->dist;
 }
 
 1;



More information about the Bps-public-commit mailing list