[Bps-public-commit] r20069 - in DBIx-SearchBuilder/trunk: . inc/Module/Install

ruz at bestpractical.com ruz at bestpractical.com
Tue Jun 30 18:39:02 EDT 2009


Author: ruz
Date: Tue Jun 30 18:39:01 2009
New Revision: 20069

Modified:
   DBIx-SearchBuilder/trunk/META.yml
   DBIx-SearchBuilder/trunk/inc/Module/AutoInstall.pm
   DBIx-SearchBuilder/trunk/inc/Module/Install.pm
   DBIx-SearchBuilder/trunk/inc/Module/Install/AutoInstall.pm
   DBIx-SearchBuilder/trunk/inc/Module/Install/Base.pm
   DBIx-SearchBuilder/trunk/inc/Module/Install/Include.pm
   DBIx-SearchBuilder/trunk/inc/Module/Install/Makefile.pm
   DBIx-SearchBuilder/trunk/inc/Module/Install/Metadata.pm

Log:
* update M::I

Modified: DBIx-SearchBuilder/trunk/META.yml
==============================================================================
--- DBIx-SearchBuilder/trunk/META.yml	(original)
+++ DBIx-SearchBuilder/trunk/META.yml	Tue Jun 30 18:39:01 2009
@@ -10,7 +10,7 @@
 configure_requires:
   ExtUtils::MakeMaker: 6.42
 distribution_type: module
-generated_by: 'Module::Install version 0.85'
+generated_by: 'Module::Install version 0.90'
 license: perl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html

Modified: DBIx-SearchBuilder/trunk/inc/Module/AutoInstall.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/inc/Module/AutoInstall.pm	(original)
+++ DBIx-SearchBuilder/trunk/inc/Module/AutoInstall.pm	Tue Jun 30 18:39:01 2009
@@ -18,7 +18,9 @@
 
 # various lexical flags
 my ( @Missing, @Existing,  %DisabledTests, $UnderCPAN,     $HasCPANPLUS );
-my ( $Config,  $CheckOnly, $SkipInstall,   $AcceptDefault, $TestOnly );
+my (
+    $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
+);
 my ( $PostambleActions, $PostambleUsed );
 
 # See if it's a testing or non-interactive session
@@ -73,6 +75,9 @@
         elsif ( $arg =~ /^--test(?:only)?$/ ) {
             $TestOnly = 1;
         }
+        elsif ( $arg =~ /^--all(?:deps)?$/ ) {
+            $AllDeps = 1;
+        }
     }
 }
 
@@ -115,7 +120,12 @@
         )[0]
     );
 
-    $UnderCPAN = _check_lock(1);    # check for $UnderCPAN
+    # We want to know if we're under CPAN early to avoid prompting, but
+    # if we aren't going to try and install anything anyway then skip the
+    # check entirely since we don't want to have to load (and configure)
+    # an old CPAN just for a cosmetic message
+
+    $UnderCPAN = _check_lock(1) unless $SkipInstall;
 
     while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
         my ( @required, @tests, @skiptests );
@@ -165,15 +175,24 @@
             }
 
             # XXX: check for conflicts and uninstalls(!) them.
-            if (
-                defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) )
+            my $cur = _load($mod);
+            if (_version_cmp ($cur, $arg) >= 0)
             {
                 print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
                 push @Existing, $mod => $arg;
                 $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
             }
             else {
-                print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
+                if (not defined $cur)   # indeed missing
+                {
+                    print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
+                }
+                else
+                {
+                    # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
+                    print "too old. ($cur < $arg)\n";
+                }
+
                 push @required, $mod => $arg;
             }
         }
@@ -187,6 +206,7 @@
             and (
                 $CheckOnly
                 or ($mandatory and $UnderCPAN)
+                or $AllDeps
                 or _prompt(
                     qq{==> Auto-install the }
                       . ( @required / 2 )
@@ -235,21 +255,38 @@
     *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
 }
 
+sub _running_under {
+    my $thing = shift;
+    print <<"END_MESSAGE";
+*** Since we're running under ${thing}, I'll just let it take care
+    of the dependency's installation later.
+END_MESSAGE
+    return 1;
+}
+
 # Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
 # if we are, then we simply let it taking care of our dependencies
 sub _check_lock {
     return unless @Missing or @_;
 
+    my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
+
     if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
-        print <<'END_MESSAGE';
+        return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
+    }
 
-*** Since we're running under CPANPLUS, I'll just let it take care
-    of the dependency's installation later.
-END_MESSAGE
-        return 1;
+    require CPAN;
+
+    if ($CPAN::VERSION > '1.89') {
+        if ($cpan_env) {
+            return _running_under('CPAN');
+        }
+        return; # CPAN.pm new enough, don't need to check further
     }
 
-    _load_cpan();
+    # last ditch attempt, this -will- configure CPAN, very sorry
+
+    _load_cpan(1); # force initialize even though it's already loaded
 
     # Find the CPAN lock-file
     my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
@@ -285,7 +322,7 @@
     while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
 
         # grep out those already installed
-        if ( defined( _version_check( _load($pkg), $ver ) ) ) {
+        if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
             push @installed, $pkg;
         }
         else {
@@ -324,7 +361,7 @@
 
     # see if we have successfully installed them
     while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
-        if ( defined( _version_check( _load($pkg), $ver ) ) ) {
+        if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
             push @installed, $pkg;
         }
         elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
@@ -379,7 +416,7 @@
         my $success;
         my $obj = $modtree->{$pkg};
 
-        if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) {
+        if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
             my $pathname = $pkg;
             $pathname =~ s/::/\\W/;
 
@@ -472,7 +509,7 @@
         my $obj     = CPAN::Shell->expand( Module => $pkg );
         my $success = 0;
 
-        if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) {
+        if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
             my $pathname = $pkg;
             $pathname =~ s/::/\\W/;
 
@@ -536,7 +573,7 @@
     my $ver   = shift;
 
     return
-      if defined( _version_check( _load($class), $ver ) );  # no need to upgrade
+      if _version_cmp( _load($class), $ver ) >= 0;  # no need to upgrade
 
     if (
         _prompt( "==> A newer version of $class ($ver) is required. Install?",
@@ -633,7 +670,7 @@
 
 # Load CPAN.pm and it's configuration
 sub _load_cpan {
-    return if $CPAN::VERSION;
+    return if $CPAN::VERSION and $CPAN::Config and not @_;
     require CPAN;
     if ( $CPAN::HandleConfig::VERSION ) {
         # Newer versions of CPAN have a HandleConfig module
@@ -645,9 +682,11 @@
 }
 
 # compare two versions, either use Sort::Versions or plain comparison
-sub _version_check {
+# return values same as <=>
+sub _version_cmp {
     my ( $cur, $min ) = @_;
-    return unless defined $cur;
+    return -1 unless defined $cur;  # if 0 keep comparing
+    return 1 unless $min;
 
     $cur =~ s/\s+$//;
 
@@ -658,16 +697,13 @@
             ) {
 
             # use version.pm if it is installed.
-            return (
-                ( version->new($cur) >= version->new($min) ) ? $cur : undef );
+            return version->new($cur) <=> version->new($min);
         }
         elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
         {
 
             # use Sort::Versions as the sorting algorithm for a.b.c versions
-            return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 )
-                ? $cur
-                : undef );
+            return Sort::Versions::versioncmp( $cur, $min );
         }
 
         warn "Cannot reliably compare non-decimal formatted versions.\n"
@@ -676,7 +712,7 @@
 
     # plain comparison
     local $^W = 0;    # shuts off 'not numeric' bugs
-    return ( $cur >= $min ? $cur : undef );
+    return $cur <=> $min;
 }
 
 # nothing; this usage is deprecated.
@@ -766,4 +802,4 @@
 
 __END__
 
-#line 1004
+#line 1056

Modified: DBIx-SearchBuilder/trunk/inc/Module/Install.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/inc/Module/Install.pm	(original)
+++ DBIx-SearchBuilder/trunk/inc/Module/Install.pm	Tue Jun 30 18:39:01 2009
@@ -28,7 +28,7 @@
 	# This is not enforced yet, but will be some time in the next few
 	# releases once we can make sure it won't clash with custom
 	# Module::Install extensions.
-	$VERSION = '0.85';
+	$VERSION = '0.90';
 
 	# Storage for the pseudo-singleton
 	$MAIN    = undef;
@@ -353,7 +353,7 @@
 	if ( $] >= 5.006 ) {
 		open( FH, '<', $_[0] ) or die "open($_[0]): $!";
 	} else {
-		open( FH, "< $_[0]"  ) or die "open($_[0]): $!";	
+		open( FH, "< $_[0]"  ) or die "open($_[0]): $!";
 	}
 	my $string = do { local $/; <FH> };
 	close FH or die "close($_[0]): $!";
@@ -384,7 +384,7 @@
 	if ( $] >= 5.006 ) {
 		open( FH, '>', $_[0] ) or die "open($_[0]): $!";
 	} else {
-		open( FH, "> $_[0]"  ) or die "open($_[0]): $!";	
+		open( FH, "> $_[0]"  ) or die "open($_[0]): $!";
 	}
 	foreach ( 1 .. $#_ ) {
 		print FH $_[$_] or die "print($_[0]): $!";

Modified: DBIx-SearchBuilder/trunk/inc/Module/Install/AutoInstall.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/inc/Module/Install/AutoInstall.pm	(original)
+++ DBIx-SearchBuilder/trunk/inc/Module/Install/AutoInstall.pm	Tue Jun 30 18:39:01 2009
@@ -2,13 +2,13 @@
 package Module::Install::AutoInstall;
 
 use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
 
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.85';
+	$VERSION = '0.90';
+	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
-	@ISA     = qw{Module::Install::Base};
 }
 
 sub AutoInstall { $_[0] }

Modified: DBIx-SearchBuilder/trunk/inc/Module/Install/Base.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/inc/Module/Install/Base.pm	(original)
+++ DBIx-SearchBuilder/trunk/inc/Module/Install/Base.pm	Tue Jun 30 18:39:01 2009
@@ -4,7 +4,7 @@
 use strict 'vars';
 use vars qw{$VERSION};
 BEGIN {
-	$VERSION = '0.85';
+	$VERSION = '0.90';
 }
 
 # Suspend handler for "redefined" warnings
@@ -13,42 +13,34 @@
 	$SIG{__WARN__} = sub { $w };
 }
 
-### This is the ONLY module that shouldn't have strict on
-# use strict;
-
-#line 45
+#line 42
 
 sub new {
-	my ($class, %args) = @_;
-
-	foreach my $method ( qw(call load) ) {
-		next if defined &{"$class\::$method"};
-		*{"$class\::$method"} = sub {
-			shift()->_top->$method(@_);
-		};
+	my $class = shift;
+	unless ( defined &{"${class}::call"} ) {
+		*{"${class}::call"} = sub { shift->_top->call(@_) };
 	}
-
-	bless( \%args, $class );
+	unless ( defined &{"${class}::load"} ) {
+		*{"${class}::load"} = sub { shift->_top->load(@_) };
+	}
+	bless { @_ }, $class;
 }
 
-#line 66
+#line 61
 
 sub AUTOLOAD {
-	my $self = shift;
 	local $@;
-	my $autoload = eval {
-		$self->_top->autoload
-	} or return;
-	goto &$autoload;
+	my $func = eval { shift->_top->autoload } or return;
+	goto &$func;
 }
 
-#line 83
+#line 75
 
 sub _top {
 	$_[0]->{_top};
 }
 
-#line 98
+#line 90
 
 sub admin {
 	$_[0]->_top->{admin}
@@ -56,7 +48,7 @@
 	Module::Install::Base::FakeAdmin->new;
 }
 
-#line 114
+#line 106
 
 sub is_admin {
 	$_[0]->admin->VERSION;
@@ -83,4 +75,4 @@
 
 1;
 
-#line 162
+#line 154

Modified: DBIx-SearchBuilder/trunk/inc/Module/Install/Include.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/inc/Module/Install/Include.pm	(original)
+++ DBIx-SearchBuilder/trunk/inc/Module/Install/Include.pm	Tue Jun 30 18:39:01 2009
@@ -2,13 +2,13 @@
 package Module::Install::Include;
 
 use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
 
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.85';
+	$VERSION = '0.90';
+	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
-	@ISA     = qw{Module::Install::Base};
 }
 
 sub include {

Modified: DBIx-SearchBuilder/trunk/inc/Module/Install/Makefile.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/inc/Module/Install/Makefile.pm	(original)
+++ DBIx-SearchBuilder/trunk/inc/Module/Install/Makefile.pm	Tue Jun 30 18:39:01 2009
@@ -2,14 +2,14 @@
 package Module::Install::Makefile;
 
 use strict 'vars';
-use Module::Install::Base;
-use ExtUtils::MakeMaker ();
+use ExtUtils::MakeMaker   ();
+use Module::Install::Base ();
 
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.85';
+	$VERSION = '0.90';
+	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
-	@ISA     = qw{Module::Install::Base};
 }
 
 sub Makefile { $_[0] }

Modified: DBIx-SearchBuilder/trunk/inc/Module/Install/Metadata.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/inc/Module/Install/Metadata.pm	(original)
+++ DBIx-SearchBuilder/trunk/inc/Module/Install/Metadata.pm	Tue Jun 30 18:39:01 2009
@@ -2,18 +2,17 @@
 package Module::Install::Metadata;
 
 use strict 'vars';
-use Module::Install::Base;
+use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-	$VERSION = '0.85';
-	@ISA     = qw{Module::Install::Base};
+	$VERSION = '0.90';
+	@ISA     = 'Module::Install::Base';
 	$ISCORE  = 1;
 }
 
 my @boolean_keys = qw{
 	sign
-	mymeta
 };
 
 my @scalar_keys = qw{
@@ -440,21 +439,21 @@
 	/ixms ) {
 		my $license_text = $1;
 		my @phrases      = (
-			'under the same (?:terms|license) as perl itself' => 'perl',        1,
-			'GNU general public license'                      => 'gpl',         1,
-			'GNU public license'                              => 'gpl',         1,
-			'GNU lesser general public license'               => 'lgpl',        1,
-			'GNU lesser public license'                       => 'lgpl',        1,
-			'GNU library general public license'              => 'lgpl',        1,
-			'GNU library public license'                      => 'lgpl',        1,
-			'BSD license'                                     => 'bsd',         1,
-			'Artistic license'                                => 'artistic',    1,
-			'GPL'                                             => 'gpl',         1,
-			'LGPL'                                            => 'lgpl',        1,
-			'BSD'                                             => 'bsd',         1,
-			'Artistic'                                        => 'artistic',    1,
-			'MIT'                                             => 'mit',         1,
-			'proprietary'                                     => 'proprietary', 0,
+			'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
+			'GNU general public license'         => 'gpl',         1,
+			'GNU public license'                 => 'gpl',         1,
+			'GNU lesser general public license'  => 'lgpl',        1,
+			'GNU lesser public license'          => 'lgpl',        1,
+			'GNU library general public license' => 'lgpl',        1,
+			'GNU library public license'         => 'lgpl',        1,
+			'BSD license'                        => 'bsd',         1,
+			'Artistic license'                   => 'artistic',    1,
+			'GPL'                                => 'gpl',         1,
+			'LGPL'                               => 'lgpl',        1,
+			'BSD'                                => 'bsd',         1,
+			'Artistic'                           => 'artistic',    1,
+			'MIT'                                => 'mit',         1,
+			'proprietary'                        => 'proprietary', 0,
 		);
 		while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
 			$pattern =~ s{\s+}{\\s+}g;
@@ -511,12 +510,13 @@
 # Also, convert double-part versions (eg, 5.8)
 sub _perl_version {
 	my $v = $_[-1];
-	$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;	
+	$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
 	$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
 	$v =~ s/(\.\d\d\d)000$/$1/;
 	$v =~ s/_.+$//;
 	if ( ref($v) ) {
-		$v = $v + 0; # Numify
+		# Numify
+		$v = $v + 0;
 	}
 	return $v;
 }
@@ -526,23 +526,58 @@
 
 
 ######################################################################
-# MYMETA.yml Support
+# MYMETA Support
 
 sub WriteMyMeta {
 	die "WriteMyMeta has been deprecated";
 }
 
-sub write_mymeta {
+sub write_mymeta_yaml {
 	my $self = shift;
-	
-	# If there's no existing META.yml there is nothing we can do
-	return unless -f 'META.yml';
 
 	# We need YAML::Tiny to write the MYMETA.yml file
 	unless ( eval { require YAML::Tiny; 1; } ) {
 		return 1;
 	}
 
+	# Generate the data
+	my $meta = $self->_write_mymeta_data or return 1;
+
+	# Save as the MYMETA.yml file
+	print "Writing MYMETA.yml\n";
+	YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+}
+
+sub write_mymeta_json {
+	my $self = shift;
+
+	# We need JSON to write the MYMETA.json file
+	unless ( eval { require JSON; 1; } ) {
+		return 1;
+	}
+
+	# Generate the data
+	my $meta = $self->_write_mymeta_data or return 1;
+
+	# Save as the MYMETA.yml file
+	print "Writing MYMETA.json\n";
+	Module::Install::_write(
+		'MYMETA.json',
+		JSON->new->pretty(1)->canonical->encode($meta),
+	);
+}
+
+sub _write_mymeta_data {
+	my $self = shift;
+
+	# If there's no existing META.yml there is nothing we can do
+	return undef unless -f 'META.yml';
+
+	# We need Parse::CPAN::Meta to load the file
+	unless ( eval { require Parse::CPAN::Meta; 1; } ) {
+		return undef;
+	}
+
 	# Merge the perl version into the dependencies
 	my $val  = $self->Meta->{values};
 	my $perl = delete $val->{perl_version};
@@ -558,7 +593,7 @@
 	}
 
 	# Load the advisory META.yml file
-	my @yaml = YAML::Tiny::LoadFile('META.yml');
+	my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
 	my $meta = $yaml[0];
 
 	# Overwrite the non-configure dependency hashs
@@ -572,9 +607,7 @@
 		$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
 	}
 
-	# Save as the MYMETA.yml file
-	print "Writing MYMETA.yml\n";
-	YAML::Tiny::DumpFile('MYMETA.yml', $meta);	
+	return $meta;
 }
 
 1;



More information about the Bps-public-commit mailing list