X-Git-Url: http://erislabs.net/gitweb/?p=libwww-opensearch-perl.git;a=blobdiff_plain;f=inc%2FModule%2FInstall.pm;h=51eda5de20c85ecec5ed7dae95e1e57ab0aee30f;hp=760da11e4476c99794a5d415ea5787f53a03d8e0;hb=85d58c49caf33a66fdee3b54c6fda4981c7a8d47;hpb=8a4c5378ad9614e2d4d066968b85f215fd5671d3

diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 760da11..51eda5d 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -17,12 +17,10 @@ package Module::Install;
 #     3. The ./inc/ version of Module::Install loads
 # }
 
-BEGIN {
-	require 5.004;
-}
+use 5.005;
 use strict 'vars';
 
-use vars qw{$VERSION};
+use vars qw{$VERSION $MAIN};
 BEGIN {
 	# All Module::Install core packages now require synchronised versions.
 	# This will be used to ensure we don't accidentally load old or
@@ -30,7 +28,14 @@ BEGIN {
 	# 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.71';
+	$VERSION = '0.91';
+
+	# Storage for the pseudo-singleton
+	$MAIN    = undef;
+
+	*inc::Module::Install::VERSION = *VERSION;
+	@inc::Module::Install::ISA     = __PACKAGE__;
+
 }
 
 
@@ -65,15 +70,26 @@ END_DIE
 # again. This is bad. Rather than taking action to touch it (which
 # is unreliable on some platforms and requires write permissions)
 # for now we should catch this and refuse to run.
-if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" }
+if ( -f $0 ) {
+	my $s = (stat($0))[9];
+
+	# If the modification time is only slightly in the future,
+	# sleep briefly to remove the problem.
+	my $a = $s - time;
+	if ( $a > 0 and $a < 5 ) { sleep 5 }
 
-Your installer $0 has a modification time in the future.
+	# Too far in the future, throw an error.
+	my $t = time;
+	if ( $s > $t ) { die <<"END_DIE" }
+
+Your installer $0 has a modification time in the future ($s > $t).
 
 This is known to create infinite loops in make.
 
 Please correct this, then run $0 again.
 
 END_DIE
+}
 
 
 
@@ -81,7 +97,7 @@ END_DIE
 
 # Build.PL was formerly supported, but no longer is due to excessive
 # difficulty in implementing every single feature twice.
-if ( $0 =~ /Build.PL$/i or -f 'Build.PL' ) { die <<"END_DIE" }
+if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
 
 Module::Install no longer supports Build.PL.
 
@@ -95,14 +111,20 @@ END_DIE
 
 
 
+# To save some more typing in Module::Install installers, every...
+# use inc::Module::Install
+# ...also acts as an implicit use strict.
+$^H |= strict::bits(qw(refs subs vars));
+
+
+
+
+
 use Cwd        ();
 use File::Find ();
 use File::Path ();
 use FindBin;
 
-*inc::Module::Install::VERSION = *VERSION;
-@inc::Module::Install::ISA     = __PACKAGE__;
-
 sub autoload {
 	my $self = shift;
 	my $who  = $self->_caller;
@@ -111,12 +133,22 @@ sub autoload {
 	$sym->{$cwd} = sub {
 		my $pwd = Cwd::cwd();
 		if ( my $code = $sym->{$pwd} ) {
-			# delegate back to parent dirs
+			# Delegate back to parent dirs
 			goto &$code unless $cwd eq $pwd;
 		}
 		$$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
+		my $method = $1;
+		if ( uc($method) eq $method ) {
+			# Do nothing
+			return;
+		} elsif ( $method =~ /^_/ and $self->can($method) ) {
+			# Dispatch to the root M:I class
+			return $self->$method(@_);
+		}
+
+		# Dispatch to the appropriate plugin
 		unshift @_, ( $self, $1 );
-		goto &{$self->can('call')} unless uc($1) eq $1;
+		goto &{$self->can('call')};
 	};
 }
 
@@ -141,6 +173,9 @@ sub import {
 	delete $INC{"$self->{file}"};
 	delete $INC{"$self->{path}.pm"};
 
+	# Save to the singleton
+	$MAIN = $self;
+
 	return 1;
 }
 
@@ -154,8 +189,7 @@ sub preload {
 
 	my @exts = @{$self->{extensions}};
 	unless ( @exts ) {
-		my $admin = $self->{admin};
-		@exts = $admin->load_all_extensions;
+		@exts = $self->{admin}->load_all_extensions;
 	}
 
 	my %seen;
@@ -238,7 +272,7 @@ END_DIE
 sub load_extensions {
 	my ($self, $path, $top) = @_;
 
-	unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
+	unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
 		unshift @INC, $self->{prefix};
 	}
 
@@ -302,7 +336,7 @@ sub find_extensions {
 
 
 #####################################################################
-# Utility Functions
+# Common Utility Functions
 
 sub _caller {
 	my $depth = 0;
@@ -316,28 +350,81 @@ sub _caller {
 
 sub _read {
 	local *FH;
-	open FH, "< $_[0]" or die "open($_[0]): $!";
-	my $str = do { local $/; <FH> };
+	if ( $] >= 5.006 ) {
+		open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+	} else {
+		open( FH, "< $_[0]"  ) or die "open($_[0]): $!";
+	}
+	my $string = do { local $/; <FH> };
 	close FH or die "close($_[0]): $!";
-	return $str;
+	return $string;
+}
+
+sub _readperl {
+	my $string = Module::Install::_read($_[0]);
+	$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+	$string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
+	$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
+	return $string;
+}
+
+sub _readpod {
+	my $string = Module::Install::_read($_[0]);
+	$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+	return $string if $_[0] =~ /\.pod\z/;
+	$string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
+	$string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
+	$string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
+	$string =~ s/^\n+//s;
+	return $string;
 }
 
 sub _write {
 	local *FH;
-	open FH, "> $_[0]" or die "open($_[0]): $!";
-	foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
+	if ( $] >= 5.006 ) {
+		open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+	} else {
+		open( FH, "> $_[0]"  ) or die "open($_[0]): $!";
+	}
+	foreach ( 1 .. $#_ ) {
+		print FH $_[$_] or die "print($_[0]): $!";
+	}
 	close FH or die "close($_[0]): $!";
 }
 
-sub _version {
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+sub _version ($) {
 	my $s = shift || 0;
-	   $s =~ s/^(\d+)\.?//;
+	my $d =()= $s =~ /(\.)/g;
+	if ( $d >= 2 ) {
+		# Normalise multipart versions
+		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
+	}
+	$s =~ s/^(\d+)\.?//;
 	my $l = $1 || 0;
-	my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
-	   $l = $l . '.' . join '', @v if @v;
+	my @v = map {
+		$_ . '0' x (3 - length $_)
+	} $s =~ /(\d{1,3})\D?/g;
+	$l = $l . '.' . join '', @v if @v;
 	return $l + 0;
 }
 
+sub _cmp ($$) {
+	_version($_[0]) <=> _version($_[1]);
+}
+
+# Cloned from Params::Util::_CLASS
+sub _CLASS ($) {
+	(
+		defined $_[0]
+		and
+		! ref $_[0]
+		and
+		$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
+	) ? $_[0] : undef;
+}
+
 1;
 
-# Copyright 2008 Adam Kennedy.
+# Copyright 2008 - 2009 Adam Kennedy.