[Bps-public-commit] r14749 - in Shipwright/trunk: lib/Shipwright/Source

sunnavy at bestpractical.com sunnavy at bestpractical.com
Mon Aug 4 06:10:35 EDT 2008


Author: sunnavy
Date: Mon Aug  4 06:10:33 2008
New Revision: 14749

Modified:
   Shipwright/trunk/   (props changed)
   Shipwright/trunk/lib/Shipwright/Source/Base.pm

Log:
 r15264 at sunnavys-mb:  sunnavy | 2008-08-04 18:10:08 +0800
 refactor stuff of finding prereqs for Makefile.PL


Modified: Shipwright/trunk/lib/Shipwright/Source/Base.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/Base.pm	(original)
+++ Shipwright/trunk/lib/Shipwright/Source/Base.pm	Mon Aug  4 06:10:33 2008
@@ -87,7 +87,7 @@
             Shipwright::Util->run( [ $^X, 'Build.PL' ] );
             my $source = read_file( File::Spec->catfile( '_build', 'prereqs' ) )
               or die "can't read _build/prereqs: $!";
-            my $eval .= '$require = ' . $source;
+            my $eval = '$require = ' . $source;
             eval $eval or die "eval error: $@";    ## no critic
 
             $source = read_file( File::Spec->catfile('Build.PL') )
@@ -103,22 +103,66 @@
             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 && $source =~ /({.*})/ ) {
-                my $eval .= '$require = ' . $1;
-                $eval =~ s/([\w:]+)=>/'$1'=>/g;
-                eval $eval or die "eval error: $@";    ## no critic
+            my $makefile = read_file('Makefile.PL')
+              or die "can't read Makefile.PL: $!";
+
+            $makefile =~ s/^\s*requires(?!\w)/shipwright_requires/mg;
+            $makefile =~
+              s/^\s*build_requires(?!\w)/shipwright_build_requires/mg;
+            $makefile =~ s/^\s*features(?!\w)/shipwright_features/mg;
+            my $shipwright_makefile = <<'EOF';
+my $shipwright_req = {};
+
+sub shipwright_requires {
+    $shipwright_req->{requires}{$_[0]} = $_[1] || 0;
+    goto &requires;
+}
+
+sub shipwright_build_requires {
+    $shipwright_req->{build_requires}{$_[0]} = $_[1] || 0;
+    goto &build_requires;
+}
+
+sub shipwright_features {
+    my @args = @_;
+    while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
+        for ( my $i = 0; $i < @$mods; $i++ ) {
+            if ( $mods->[$i] eq '-default' ) {
+                $i++;
+                next;
             }
 
-            for ( keys %$require ) {
-                $require->{requires}{$_} = delete $require->{$_};
+            if ( $mods->[$i+1] =~ /^[\d\.]+$/ ) {
+                # index $i+1 is a version
+                $shipwright_req->{recommends}{$mods->[$i]} = $mods->[$i+1];
+                $i++;
+            }
+            else {
+                $shipwright_req->{recommends}{$mods->[$i]} = 0;
             }
+        }
+    }
+    
+    goto &features;
+}
 
-            $source = read_file('Makefile.PL')
-              or die "can't read Makefile.PL: $!";
+END {
+require Data::Dumper;
+open my $tmp_fh, '>', 'shipwright_prereqs';
+print $tmp_fh Data::Dumper->Dump( [$shipwright_req], [qw/require/] );
+}
+
+EOF
+            
+            $shipwright_makefile .= $makefile;
+            write_file( 'shipwright_makefile.pl', $shipwright_makefile );
+
+            Shipwright::Util->run( [ $^X, 'shipwright_makefile.pl' ] );
+            my $prereqs = read_file( File::Spec->catfile('shipwright_prereqs') )
+              or die "can't read prereqs: $!";
+            eval $prereqs or die "eval error: $@";    ## no critic
 
-            if (   $source =~ /ExtUtils::/
+            if (   $makefile =~ /ExtUtils::/
                 && $self->name ne 'cpan-ExtUtils-MakeMaker' )
             {
                 unless ( defined $require->{requires}{'ExtUtils::MakeMaker'}
@@ -129,22 +173,10 @@
                 }
             }
 
-#      # 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::Util::LoadFile($meta_path);
-#
-#                for (qw/recommends build_requires/) {
-#                    my $keep = 'keep_' . $_;
-#                    if ( $self->$keep && $meta->{$_} && ! $require->{$_} ) {
-#                        $require->{$_} = $meta->{$_};
-#                    }
-#                }
-#            }
-
             Shipwright::Util->run( [ 'make', 'clean' ] );
             Shipwright::Util->run( [ 'rm',   'Makefile.old' ] );
+            Shipwright::Util->run( [ 'rm',   'shipwright_makefile.pl' ] );
+            Shipwright::Util->run( [ 'rm',   'shipwright_prereqs' ] );
         }
 
         for my $type (qw/requires recommends build_requires/) {



More information about the Bps-public-commit mailing list