Commit dc594caf912165abc75cad2427cb6dad9dcf14d7 - libcrypt-openssl-x509-perl

* New upstream release. * debian/watch: Use smarter regex. Roberto C. Sanchez 16 years ago

20 changed file(s) with 2237 addition(s) and 10 deletion(s). Raw diff Collapse all Expand all

-0

Changes less more

0	0	Revision history for Perl extension Crypt::OpenSSL::X509.
	1
	2	0.6 Sat Feb 23 14:18:30 PST 2008
	3	- RT #28684: Failed test 'use Crypt::OpenSSL::X509;'
1	4
2	5	0.5 Sat Jun 2 11:12:03 PDT 2007
3	6

+20

-7

MANIFEST less more

	0	certs/thawte.pem
	1	certs/vsign1.pem
0	2	Changes
	3	inc/Module/AutoInstall.pm
	4	inc/Module/Install.pm
	5	inc/Module/Install/AutoInstall.pm
	6	inc/Module/Install/Base.pm
	7	inc/Module/Install/Can.pm
	8	inc/Module/Install/Compiler.pm
	9	inc/Module/Install/External.pm
	10	inc/Module/Install/Fetch.pm
	11	inc/Module/Install/Include.pm
	12	inc/Module/Install/Makefile.pm
	13	inc/Module/Install/Metadata.pm
	14	inc/Module/Install/Win32.pm
	15	inc/Module/Install/WriteAll.pm
1	16	Makefile.PL
2	17	MANIFEST
	18	META.yml Module meta-data (added by MakeMaker)
3	19	README
	20	t/pod.t
	21	t/x509.t
	22	TODO
	23	typemap
4	24	X509.pm
5	25	X509.xs
6		TODO
7		t/pod.t
8		t/x509.t
9		typemap
10		certs/thawte.pem
11		certs/vsign1.pem
12		META.yml Module meta-data (added by MakeMaker)

+13

-0

Makefile.PL less more

6	6	perl_version('5.005');
7	7	all_from('X509.pm');
8	8
	9	requires_external_cc();
	10
	11	if (-d "/usr/include/openssl") {
	12	cc_inc_paths('/usr/include/openssl');
	13	cc_lib_paths('/usr/lib');
	14	} elsif (-d "/usr/local/include/ssl") {
	15	cc_inc_paths('/usr/local/include/ssl');
	16	cc_lib_paths('/usr/local/lib/ssl');
	17	} elsif (-d "/usr/local/ssl/include") {
	18	cc_inc_paths('/usr/local/ssl/include');
	19	cc_lib_paths('/usr/local/ssl/lib');
	20	}
	21
9	22	cc_lib_links('crypto');
10	23	cc_optimize_flags('-g -Wall');
11	24

-1

README less more

0		Crypt/OpenSSL/X509 version 0.4
	0	Crypt/OpenSSL/X509 version 0.6
1	1	===============================
2	2
3	3	The README is used to introduce the module and provide instructions on

-1

X509.pm less more

4	4	use Exporter;
5	5	use base qw(Exporter);
6	6
7		$VERSION = '0.5';
	7	$VERSION = '0.6';
8	8
9	9	@EXPORT_OK = qw(
10	10	FORMAT_UNDEF FORMAT_ASN1 FORMAT_TEXT FORMAT_PEM FORMAT_NETSCAPE

-0

debian/changelog less more

	0	libcrypt-openssl-x509-perl (0.6-1) unstable; urgency=low
	1
	2	* New upstream release.
	3	* debian/watch: Use smarter regex.
	4
	5	-- Roberto C. Sanchez <roberto@debian.org> Sat, 15 Mar 2008 23:01:10 -0400
	6
0	7	libcrypt-openssl-x509-perl (0.5-2) unstable; urgency=low
1	8
2	9	[ gregor herrmann ]

-1

debian/watch less more

0	0	# format version number, currently 3; this line is compulsory!
1	1	version=3
2		http://search.cpan.org/dist/Crypt-OpenSSL-X509 ./Crypt-OpenSSL-X509-(\d.)\.tar\.gz
	2	http://search.cpan.org/dist/Crypt-OpenSSL-X509/ .*/Crypt-OpenSSL-X509-v?(\d[\d.]+)\.(?:tar(?:\.gz\|\.bz2)?\|tgz\|zip)

+768

-0

inc/Module/AutoInstall.pm less more

	0	#line 1
	1	package Module::AutoInstall;
	2
	3	use strict;
	4	use Cwd ();
	5	use ExtUtils::MakeMaker ();
	6
	7	use vars qw{$VERSION};
	8	BEGIN {
	9	$VERSION = '1.03';
	10	}
	11
	12	# special map on pre-defined feature sets
	13	my %FeatureMap = (
	14	'' => 'Core Features', # XXX: deprecated
	15	'-core' => 'Core Features',
	16	);
	17
	18	# various lexical flags
	19	my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
	20	my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly );
	21	my ( $PostambleActions, $PostambleUsed );
	22
	23	# See if it's a testing or non-interactive session
	24	_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
	25	_init();
	26
	27	sub _accept_default {
	28	$AcceptDefault = shift;
	29	}
	30
	31	sub missing_modules {
	32	return @Missing;
	33	}
	34
	35	sub do_install {
	36	__PACKAGE__->install(
	37	[
	38	$Config
	39	? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
	40	: ()
	41	],
	42	@Missing,
	43	);
	44	}
	45
	46	# initialize various flags, and/or perform install
	47	sub _init {
	48	foreach my $arg (
	49	@ARGV,
	50	split(
	51	/[\s\t]+/,
	52	$ENV{PERL_AUTOINSTALL} \|\| $ENV{PERL_EXTUTILS_AUTOINSTALL} \|\| ''
	53	)
	54	)
	55	{
	56	if ( $arg =~ /^--config=(.*)$/ ) {
	57	$Config = [ split( ',', $1 ) ];
	58	}
	59	elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
	60	__PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
	61	exit 0;
	62	}
	63	elsif ( $arg =~ /^--default(?:deps)?$/ ) {
	64	$AcceptDefault = 1;
	65	}
	66	elsif ( $arg =~ /^--check(?:deps)?$/ ) {
	67	$CheckOnly = 1;
	68	}
	69	elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
	70	$SkipInstall = 1;
	71	}
	72	elsif ( $arg =~ /^--test(?:only)?$/ ) {
	73	$TestOnly = 1;
	74	}
	75	}
	76	}
	77
	78	# overrides MakeMaker's prompt() to automatically accept the default choice
	79	sub _prompt {
	80	goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
	81
	82	my ( $prompt, $default ) = @_;
	83	my $y = ( $default =~ /^[Yy]/ );
	84
	85	print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
	86	print "$default\n";
	87	return $default;
	88	}
	89
	90	# the workhorse
	91	sub import {
	92	my $class = shift;
	93	my @args = @_ or return;
	94	my $core_all;
	95
	96	print "*** $class version " . $class->VERSION . "\n";
	97	print "*** Checking for Perl dependencies...\n";
	98
	99	my $cwd = Cwd::cwd();
	100
	101	$Config = [];
	102
	103	my $maxlen = length(
	104	(
	105	sort { length($b) <=> length($a) }
	106	grep { /^[^\-]/ }
	107	map {
	108	ref($_)
	109	? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
	110	: ''
	111	}
	112	map { +{@args}->{$_} }
	113	grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
	114	)[0]
	115	);
	116
	117	while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
	118	my ( @required, @tests, @skiptests );
	119	my $default = 1;
	120	my $conflict = 0;
	121
	122	if ( $feature =~ m/^-(\w+)$/ ) {
	123	my $option = lc($1);
	124
	125	# check for a newer version of myself
	126	_update_to( $modules, @_ ) and return if $option eq 'version';
	127
	128	# sets CPAN configuration options
	129	$Config = $modules if $option eq 'config';
	130
	131	# promote every features to core status
	132	$core_all = ( $modules =~ /^all$/i ) and next
	133	if $option eq 'core';
	134
	135	next unless $option eq 'core';
	136	}
	137
	138	print "[" . ( $FeatureMap{ lc($feature) } \|\| $feature ) . "]\n";
	139
	140	$modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
	141
	142	unshift @$modules, -default => &{ shift(@$modules) }
	143	if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
	144
	145	while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
	146	if ( $mod =~ m/^-(\w+)$/ ) {
	147	my $option = lc($1);
	148
	149	$default = $arg if ( $option eq 'default' );
	150	$conflict = $arg if ( $option eq 'conflict' );
	151	@tests = @{$arg} if ( $option eq 'tests' );
	152	@skiptests = @{$arg} if ( $option eq 'skiptests' );
	153
	154	next;
	155	}
	156
	157	printf( "- %-${maxlen}s ...", $mod );
	158
	159	if ( $arg and $arg =~ /^\D/ ) {
	160	unshift @$modules, $arg;
	161	$arg = 0;
	162	}
	163
	164	# XXX: check for conflicts and uninstalls(!) them.
	165	if (
	166	defined( my $cur = _version_check( _load($mod), $arg \|\|= 0 ) ) )
	167	{
	168	print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
	169	push @Existing, $mod => $arg;
	170	$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
	171	}
	172	else {
	173	print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
	174	push @required, $mod => $arg;
	175	}
	176	}
	177
	178	next unless @required;
	179
	180	my $mandatory = ( $feature eq '-core' or $core_all );
	181
	182	if (
	183	!$SkipInstall
	184	and (
	185	$CheckOnly
	186	or _prompt(
	187	qq{==> Auto-install the }
	188	. ( @required / 2 )
	189	. ( $mandatory ? ' mandatory' : ' optional' )
	190	. qq{ module(s) from CPAN?},
	191	$default ? 'y' : 'n',
	192	) =~ /^[Yy]/
	193	)
	194	)
	195	{
	196	push( @Missing, @required );
	197	$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
	198	}
	199
	200	elsif ( !$SkipInstall
	201	and $default
	202	and $mandatory
	203	and
	204	_prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
	205	=~ /^[Nn]/ )
	206	{
	207	push( @Missing, @required );
	208	$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
	209	}
	210
	211	else {
	212	$DisabledTests{$_} = 1 for map { glob($_) } @tests;
	213	}
	214	}
	215
	216	$UnderCPAN = _check_lock(); # check for $UnderCPAN
	217
	218	if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
	219	require Config;
	220	print
	221	"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
	222
	223	# make an educated guess of whether we'll need root permission.
	224	print " (You may need to do that as the 'root' user.)\n"
	225	if eval '$>';
	226	}
	227	print "*** $class configuration finished.\n";
	228
	229	chdir $cwd;
	230
	231	# import to main::
	232	no strict 'refs';
	233	*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
	234	}
	235
	236	# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
	237	# if we are, then we simply let it taking care of our dependencies
	238	sub _check_lock {
	239	return unless @Missing;
	240
	241	if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
	242	print <<'END_MESSAGE';
	243
	244	*** Since we're running under CPANPLUS, I'll just let it take care
	245	of the dependency's installation later.
	246	END_MESSAGE
	247	return 1;
	248	}
	249
	250	_load_cpan();
	251
	252	# Find the CPAN lock-file
	253	my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
	254	return unless -f $lock;
	255
	256	# Check the lock
	257	local *LOCK;
	258	return unless open(LOCK, $lock);
	259
	260	if (
	261	( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
	262	and ( $CPAN::Config->{prerequisites_policy} \|\| '' ) ne 'ignore'
	263	) {
	264	print <<'END_MESSAGE';
	265
	266	*** Since we're running under CPAN, I'll just let it take care
	267	of the dependency's installation later.
	268	END_MESSAGE
	269	return 1;
	270	}
	271
	272	close LOCK;
	273	return;
	274	}
	275
	276	sub install {
	277	my $class = shift;
	278
	279	my $i; # used below to strip leading '-' from config keys
	280	my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
	281
	282	my ( @modules, @installed );
	283	while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
	284
	285	# grep out those already installed
	286	if ( defined( _version_check( _load($pkg), $ver ) ) ) {
	287	push @installed, $pkg;
	288	}
	289	else {
	290	push @modules, $pkg, $ver;
	291	}
	292	}
	293
	294	return @installed unless @modules; # nothing to do
	295	return @installed if _check_lock(); # defer to the CPAN shell
	296
	297	print "*** Installing dependencies...\n";
	298
	299	return unless _connected_to('cpan.org');
	300
	301	my %args = @config;
	302	my %failed;
	303	local *FAILED;
	304	if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
	305	while (<FAILED>) { chomp; $failed{$_}++ }
	306	close FAILED;
	307
	308	my @newmod;
	309	while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
	310	push @newmod, ( $k => $v ) unless $failed{$k};
	311	}
	312	@modules = @newmod;
	313	}
	314
	315	if ( _has_cpanplus() ) {
	316	_install_cpanplus( \@modules, \@config );
	317	} else {
	318	_install_cpan( \@modules, \@config );
	319	}
	320
	321	print "*** $class installation finished.\n";
	322
	323	# see if we have successfully installed them
	324	while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
	325	if ( defined( _version_check( _load($pkg), $ver ) ) ) {
	326	push @installed, $pkg;
	327	}
	328	elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
	329	print FAILED "$pkg\n";
	330	}
	331	}
	332
	333	close FAILED if $args{do_once};
	334
	335	return @installed;
	336	}
	337
	338	sub _install_cpanplus {
	339	my @modules = @{ +shift };
	340	my @config = _cpanplus_config( @{ +shift } );
	341	my $installed = 0;
	342
	343	require CPANPLUS::Backend;
	344	my $cp = CPANPLUS::Backend->new;
	345	my $conf = $cp->configure_object;
	346
	347	return unless $conf->can('conf') # 0.05x+ with "sudo" support
	348	or _can_write($conf->_get_build('base')); # 0.04x
	349
	350	# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
	351	my $makeflags = $conf->get_conf('makeflags') \|\| '';
	352	if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
	353	# 0.03+ uses a hashref here
	354	$makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
	355
	356	} else {
	357	# 0.02 and below uses a scalar
	358	$makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
	359	if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
	360
	361	}
	362	$conf->set_conf( makeflags => $makeflags );
	363	$conf->set_conf( prereqs => 1 );
	364
	365
	366
	367	while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
	368	$conf->set_conf( $key, $val );
	369	}
	370
	371	my $modtree = $cp->module_tree;
	372	while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
	373	print "*** Installing $pkg...\n";
	374
	375	MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
	376
	377	my $success;
	378	my $obj = $modtree->{$pkg};
	379
	380	if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) {
	381	my $pathname = $pkg;
	382	$pathname =~ s/::/\\W/;
	383
	384	foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
	385	delete $INC{$inc};
	386	}
	387
	388	my $rv = $cp->install( modules => [ $obj->{module} ] );
	389
	390	if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
	391	print "*** $pkg successfully installed.\n";
	392	$success = 1;
	393	} else {
	394	print "*** $pkg installation cancelled.\n";
	395	$success = 0;
	396	}
	397
	398	$installed += $success;
	399	} else {
	400	print << ".";
	401	*** Could not find a version $ver or above for $pkg; skipping.
	402	.
	403	}
	404
	405	MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
	406	}
	407
	408	return $installed;
	409	}
	410
	411	sub _cpanplus_config {
	412	my @config = ();
	413	while ( @_ ) {
	414	my ($key, $value) = (shift(), shift());
	415	if ( $key eq 'prerequisites_policy' ) {
	416	if ( $value eq 'follow' ) {
	417	$value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
	418	} elsif ( $value eq 'ask' ) {
	419	$value = CPANPLUS::Internals::Constants::PREREQ_ASK();
	420	} elsif ( $value eq 'ignore' ) {
	421	$value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
	422	} else {
	423	die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
	424	}
	425	} else {
	426	die "*** Cannot convert option $key to CPANPLUS version.\n";
	427	}
	428	}
	429	return @config;
	430	}
	431
	432	sub _install_cpan {
	433	my @modules = @{ +shift };
	434	my @config = @{ +shift };
	435	my $installed = 0;
	436	my %args;
	437
	438	_load_cpan();
	439	require Config;
	440
	441	if (CPAN->VERSION < 1.80) {
	442	# no "sudo" support, probe for writableness
	443	return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
	444	and _can_write( $Config::Config{sitelib} );
	445	}
	446
	447	# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
	448	my $makeflags = $CPAN::Config->{make_install_arg} \|\| '';
	449	$CPAN::Config->{make_install_arg} =
	450	join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
	451	if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
	452
	453	# don't show start-up info
	454	$CPAN::Config->{inhibit_startup_message} = 1;
	455
	456	# set additional options
	457	while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
	458	( $args{$opt} = $arg, next )
	459	if $opt =~ /^force$/; # pseudo-option
	460	$CPAN::Config->{$opt} = $arg;
	461	}
	462
	463	local $CPAN::Config->{prerequisites_policy} = 'follow';
	464
	465	while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
	466	MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
	467
	468	print "*** Installing $pkg...\n";
	469
	470	my $obj = CPAN::Shell->expand( Module => $pkg );
	471	my $success = 0;
	472
	473	if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) {
	474	my $pathname = $pkg;
	475	$pathname =~ s/::/\\W/;
	476
	477	foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
	478	delete $INC{$inc};
	479	}
	480
	481	my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
	482	: CPAN::Shell->install($pkg);
	483	$rv \|\|= eval {
	484	$CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
	485	->{install}
	486	if $CPAN::META;
	487	};
	488
	489	if ( $rv eq 'YES' ) {
	490	print "*** $pkg successfully installed.\n";
	491	$success = 1;
	492	}
	493	else {
	494	print "*** $pkg installation failed.\n";
	495	$success = 0;
	496	}
	497
	498	$installed += $success;
	499	}
	500	else {
	501	print << ".";
	502	*** Could not find a version $ver or above for $pkg; skipping.
	503	.
	504	}
	505
	506	MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
	507	}
	508
	509	return $installed;
	510	}
	511
	512	sub _has_cpanplus {
	513	return (
	514	$HasCPANPLUS = (
	515	$INC{'CPANPLUS/Config.pm'}
	516	or _load('CPANPLUS::Shell::Default')
	517	)
	518	);
	519	}
	520
	521	# make guesses on whether we're under the CPAN installation directory
	522	sub _under_cpan {
	523	require Cwd;
	524	require File::Spec;
	525
	526	my $cwd = File::Spec->canonpath( Cwd::cwd() );
	527	my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
	528
	529	return ( index( $cwd, $cpan ) > -1 );
	530	}
	531
	532	sub _update_to {
	533	my $class = __PACKAGE__;
	534	my $ver = shift;
	535
	536	return
	537	if defined( _version_check( _load($class), $ver ) ); # no need to upgrade
	538
	539	if (
	540	_prompt( "==> A newer version of $class ($ver) is required. Install?",
	541	'y' ) =~ /^[Nn]/
	542	)
	543	{
	544	die "*** Please install $class $ver manually.\n";
	545	}
	546
	547	print << ".";
	548	*** Trying to fetch it from CPAN...
	549	.
	550
	551	# install ourselves
	552	_load($class) and return $class->import(@_)
	553	if $class->install( [], $class, $ver );
	554
	555	print << '.'; exit 1;
	556
	557	*** Cannot bootstrap myself. :-( Installation terminated.
	558	.
	559	}
	560
	561	# check if we're connected to some host, using inet_aton
	562	sub _connected_to {
	563	my $site = shift;
	564
	565	return (
	566	( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
	567	qq(
	568	*** Your host cannot resolve the domain name '$site', which
	569	probably means the Internet connections are unavailable.
	570	==> Should we try to install the required module(s) anyway?), 'n'
	571	) =~ /^[Yy]/
	572	);
	573	}
	574
	575	# check if a directory is writable; may create it on demand
	576	sub _can_write {
	577	my $path = shift;
	578	mkdir( $path, 0755 ) unless -e $path;
	579
	580	return 1 if -w $path;
	581
	582	print << ".";
	583	*** You are not allowed to write to the directory '$path';
	584	the installation may fail due to insufficient permissions.
	585	.
	586
	587	if (
	588	eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
	589	qq(
	590	==> Should we try to re-execute the autoinstall process with 'sudo'?),
	591	((-t STDIN) ? 'y' : 'n')
	592	) =~ /^[Yy]/
	593	)
	594	{
	595
	596	# try to bootstrap ourselves from sudo
	597	print << ".";
	598	*** Trying to re-execute the autoinstall process with 'sudo'...
	599	.
	600	my $missing = join( ',', @Missing );
	601	my $config = join( ',',
	602	UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
	603	if $Config;
	604
	605	return
	606	unless system( 'sudo', $^X, $0, "--config=$config",
	607	"--installdeps=$missing" );
	608
	609	print << ".";
	610	*** The 'sudo' command exited with error! Resuming...
	611	.
	612	}
	613
	614	return _prompt(
	615	qq(
	616	==> Should we try to install the required module(s) anyway?), 'n'
	617	) =~ /^[Yy]/;
	618	}
	619
	620	# load a module and return the version it reports
	621	sub _load {
	622	my $mod = pop; # class/instance doesn't matter
	623	my $file = $mod;
	624
	625	$file =~ s\|::\|/\|g;
	626	$file .= '.pm';
	627
	628	local $@;
	629	return eval { require $file; $mod->VERSION } \|\| ( $@ ? undef: 0 );
	630	}
	631
	632	# Load CPAN.pm and it's configuration
	633	sub _load_cpan {
	634	return if $CPAN::VERSION;
	635	require CPAN;
	636	if ( $CPAN::HandleConfig::VERSION ) {
	637	# Newer versions of CPAN have a HandleConfig module
	638	CPAN::HandleConfig->load;
	639	} else {
	640	# Older versions had the load method in Config directly
	641	CPAN::Config->load;
	642	}
	643	}
	644
	645	# compare two versions, either use Sort::Versions or plain comparison
	646	sub _version_check {
	647	my ( $cur, $min ) = @_;
	648	return unless defined $cur;
	649
	650	$cur =~ s/\s+$//;
	651
	652	# check for version numbers that are not in decimal format
	653	if ( ref($cur) or ref($min) or $cur =~ /v\|\..\./ or $min =~ /v\|\..\./ ) {
	654	if ( ( $version::VERSION or defined( _load('version') )) and
	655	version->can('new')
	656	) {
	657
	658	# use version.pm if it is installed.
	659	return (
	660	( version->new($cur) >= version->new($min) ) ? $cur : undef );
	661	}
	662	elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
	663	{
	664
	665	# use Sort::Versions as the sorting algorithm for a.b.c versions
	666	return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 )
	667	? $cur
	668	: undef );
	669	}
	670
	671	warn "Cannot reliably compare non-decimal formatted versions.\n"
	672	. "Please install version.pm or Sort::Versions.\n";
	673	}
	674
	675	# plain comparison
	676	local $^W = 0; # shuts off 'not numeric' bugs
	677	return ( $cur >= $min ? $cur : undef );
	678	}
	679
	680	# nothing; this usage is deprecated.
	681	sub main::PREREQ_PM { return {}; }
	682
	683	sub _make_args {
	684	my %args = @_;
	685
	686	$args{PREREQ_PM} = { %{ $args{PREREQ_PM} \|\| {} }, @Existing, @Missing }
	687	if $UnderCPAN or $TestOnly;
	688
	689	if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
	690	require ExtUtils::Manifest;
	691	my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
	692
	693	$args{EXE_FILES} =
	694	[ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
	695	}
	696
	697	$args{test}{TESTS} \|\|= 't/*.t';
	698	$args{test}{TESTS} = join( ' ',
	699	grep { !exists( $DisabledTests{$_} ) }
	700	map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
	701
	702	my $missing = join( ',', @Missing );
	703	my $config =
	704	join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
	705	if $Config;
	706
	707	$PostambleActions = (
	708	$missing
	709	? "\$(PERL) $0 --config=$config --installdeps=$missing"
	710	: "\$(NOECHO) \$(NOOP)"
	711	);
	712
	713	return %args;
	714	}
	715
	716	# a wrapper to ExtUtils::MakeMaker::WriteMakefile
	717	sub Write {
	718	require Carp;
	719	Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
	720
	721	if ($CheckOnly) {
	722	print << ".";
	723	*** Makefile not written in check-only mode.
	724	.
	725	return;
	726	}
	727
	728	my %args = _make_args(@_);
	729
	730	no strict 'refs';
	731
	732	$PostambleUsed = 0;
	733	local *MY::postamble = \&postamble unless defined &MY::postamble;
	734	ExtUtils::MakeMaker::WriteMakefile(%args);
	735
	736	print << "." unless $PostambleUsed;
	737	*** WARNING: Makefile written with customized MY::postamble() without
	738	including contents from Module::AutoInstall::postamble() --
	739	auto installation features disabled. Please contact the author.
	740	.
	741
	742	return 1;
	743	}
	744
	745	sub postamble {
	746	$PostambleUsed = 1;
	747
	748	return << ".";
	749
	750	config :: installdeps
	751	\t\$(NOECHO) \$(NOOP)
	752
	753	checkdeps ::
	754	\t\$(PERL) $0 --checkdeps
	755
	756	installdeps ::
	757	\t$PostambleActions
	758
	759	.
	760
	761	}
	762
	763	1;
	764
	765	__END__
	766
	767	#line 1003

+61

-0

inc/Module/Install/AutoInstall.pm less more

	0	#line 1
	1	package Module::Install::AutoInstall;
	2
	3	use strict;
	4	use Module::Install::Base;
	5
	6	use vars qw{$VERSION $ISCORE @ISA};
	7	BEGIN {
	8	$VERSION = '0.67';
	9	$ISCORE = 1;
	10	@ISA = qw{Module::Install::Base};
	11	}
	12
	13	sub AutoInstall { $_[0] }
	14
	15	sub run {
	16	my $self = shift;
	17	$self->auto_install_now(@_);
	18	}
	19
	20	sub write {
	21	my $self = shift;
	22	$self->auto_install(@_);
	23	}
	24
	25	sub auto_install {
	26	my $self = shift;
	27	return if $self->{done}++;
	28
	29	# Flatten array of arrays into a single array
	30	my @core = map @$_, map @$_, grep ref,
	31	$self->build_requires, $self->requires;
	32
	33	my @config = @_;
	34
	35	# We'll need Module::AutoInstall
	36	$self->include('Module::AutoInstall');
	37	require Module::AutoInstall;
	38
	39	Module::AutoInstall->import(
	40	(@config ? (-config => \@config) : ()),
	41	(@core ? (-core => \@core) : ()),
	42	$self->features,
	43	);
	44
	45	$self->makemaker_args( Module::AutoInstall::_make_args() );
	46
	47	my $class = ref($self);
	48	$self->postamble(
	49	"# --- $class section:\n" .
	50	Module::AutoInstall::postamble()
	51	);
	52	}
	53
	54	sub auto_install_now {
	55	my $self = shift;
	56	$self->auto_install(@_);
	57	Module::AutoInstall::do_install();
	58	}
	59
	60	1;

+70

-0

inc/Module/Install/Base.pm less more

	0	#line 1
	1	package Module::Install::Base;
	2
	3	$VERSION = '0.67';
	4
	5	# Suspend handler for "redefined" warnings
	6	BEGIN {
	7	my $w = $SIG{__WARN__};
	8	$SIG{__WARN__} = sub { $w };
	9	}
	10
	11	### This is the ONLY module that shouldn't have strict on
	12	# use strict;
	13
	14	#line 41
	15
	16	sub new {
	17	my ($class, %args) = @_;
	18
	19	foreach my $method ( qw(call load) ) {
	20	*{"$class\::$method"} = sub {
	21	shift()->_top->$method(@_);
	22	} unless defined &{"$class\::$method"};
	23	}
	24
	25	bless( \%args, $class );
	26	}
	27
	28	#line 61
	29
	30	sub AUTOLOAD {
	31	my $self = shift;
	32	local $@;
	33	my $autoload = eval { $self->_top->autoload } or return;
	34	goto &$autoload;
	35	}
	36
	37	#line 76
	38
	39	sub _top { $_[0]->{_top} }
	40
	41	#line 89
	42
	43	sub admin {
	44	$_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new;
	45	}
	46
	47	sub is_admin {
	48	$_[0]->admin->VERSION;
	49	}
	50
	51	sub DESTROY {}
	52
	53	package Module::Install::Base::FakeAdmin;
	54
	55	my $Fake;
	56	sub new { $Fake \|\|= bless(\@_, $_[0]) }
	57
	58	sub AUTOLOAD {}
	59
	60	sub DESTROY {}
	61
	62	# Restore warning handler
	63	BEGIN {
	64	$SIG{__WARN__} = $SIG{__WARN__}->();
	65	}
	66
	67	1;
	68
	69	#line 138

+82

-0

inc/Module/Install/Can.pm less more

	0	#line 1
	1	package Module::Install::Can;
	2
	3	use strict;
	4	use Module::Install::Base;
	5	use Config ();
	6	### This adds a 5.005 Perl version dependency.
	7	### This is a bug and will be fixed.
	8	use File::Spec ();
	9	use ExtUtils::MakeMaker ();
	10
	11	use vars qw{$VERSION $ISCORE @ISA};
	12	BEGIN {
	13	$VERSION = '0.67';
	14	$ISCORE = 1;
	15	@ISA = qw{Module::Install::Base};
	16	}
	17
	18	# check if we can load some module
	19	### Upgrade this to not have to load the module if possible
	20	sub can_use {
	21	my ($self, $mod, $ver) = @_;
	22	$mod =~ s{::\|\\}{/}g;
	23	$mod .= '.pm' unless $mod =~ /\.pm$/i;
	24
	25	my $pkg = $mod;
	26	$pkg =~ s{/}{::}g;
	27	$pkg =~ s{\.pm$}{}i;
	28
	29	local $@;
	30	eval { require $mod; $pkg->VERSION($ver \|\| 0); 1 };
	31	}
	32
	33	# check if we can run some command
	34	sub can_run {
	35	my ($self, $cmd) = @_;
	36
	37	my $_cmd = $cmd;
	38	return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
	39
	40	for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
	41	my $abs = File::Spec->catfile($dir, $_[1]);
	42	return $abs if (-x $abs or $abs = MM->maybe_command($abs));
	43	}
	44
	45	return;
	46	}
	47
	48	# can we locate a (the) C compiler
	49	sub can_cc {
	50	my $self = shift;
	51	my @chunks = split(/ /, $Config::Config{cc}) or return;
	52
	53	# $Config{cc} may contain args; try to find out the program part
	54	while (@chunks) {
	55	return $self->can_run("@chunks") \|\| (pop(@chunks), next);
	56	}
	57
	58	return;
	59	}
	60
	61	# Fix Cygwin bug on maybe_command();
	62	if ( $^O eq 'cygwin' ) {
	63	require ExtUtils::MM_Cygwin;
	64	require ExtUtils::MM_Win32;
	65	if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
	66	*ExtUtils::MM_Cygwin::maybe_command = sub {
	67	my ($self, $file) = @_;
	68	if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
	69	ExtUtils::MM_Win32->maybe_command($file);
	70	} else {
	71	ExtUtils::MM_Unix->maybe_command($file);
	72	}
	73	}
	74	}
	75	}
	76
	77	1;
	78
	79	__END__
	80
	81	#line 157

+55

-0

inc/Module/Install/Compiler.pm less more

	0	#line 1
	1	package Module::Install::Compiler;
	2
	3	use strict;
	4	use Module::Install::Base;
	5	use File::Basename ();
	6
	7	use vars qw{$VERSION $ISCORE @ISA};
	8	BEGIN {
	9	$VERSION = '0.67';
	10	$ISCORE = 1;
	11	@ISA = qw{Module::Install::Base};
	12	}
	13
	14	sub cc_files {
	15	require Config;
	16	my $self = shift;
	17	$self->makemaker_args(
	18	OBJECT => join ' ', map { substr($_, 0, -2) . $Config::Config{_o} } @_
	19	);
	20	}
	21
	22	sub cc_inc_paths {
	23	my $self = shift;
	24	$self->makemaker_args(
	25	INC => join ' ', map { "-I$_" } @_
	26	);
	27	}
	28
	29	sub cc_lib_paths {
	30	my $self = shift;
	31	$self->makemaker_args(
	32	LIBS => join ' ', map { "-L$_" } @_
	33	);
	34	}
	35
	36	sub cc_lib_links {
	37	my $self = shift;
	38	$self->makemaker_args(
	39	LIBS => join ' ', $self->makemaker_args->{LIBS}, map { "-l$_" } @_
	40	);
	41	}
	42
	43	sub cc_optimize_flags {
	44	my $self = shift;
	45	$self->makemaker_args(
	46	OPTIMIZE => join ' ', @_
	47	);
	48	}
	49
	50	1;
	51
	52	__END__
	53
	54	#line 110

+66

-0

inc/Module/Install/External.pm less more

	0	#line 1
	1	package Module::Install::External;
	2
	3	# Provides dependency declarations for external non-Perl things
	4
	5	use strict;
	6	use Module::Install::Base;
	7
	8	use vars qw{$VERSION $ISCORE @ISA};
	9	BEGIN {
	10	$VERSION = '0.67';
	11	$ISCORE = 1;
	12	@ISA = qw{Module::Install::Base};
	13	}
	14
	15	sub requires_external_cc {
	16	my $self = shift;
	17
	18	# We need a C compiler, use the can_cc method for this
	19	unless ( $self->can_cc ) {
	20	print "Unresolvable missing external dependency.\n";
	21	print "This package requires a C compiler.\n";
	22	print STDERR "NA: Unable to build distribution on this platform.\n";
	23	exit(255);
	24	}
	25
	26	# Unlike some of the other modules, while we need to specify a
	27	# C compiler as a dep, it needs to be a build-time dependency.
	28
	29	1;
	30	}
	31
	32	sub requires_external_bin {
	33	my ($self, $bin, $version) = @_;
	34	if ( $version ) {
	35	die "requires_external_bin does not support versions yet";
	36	}
	37
	38	# Load the package containing can_run early,
	39	# to avoid breaking the message below.
	40	$self->load('can_run');
	41
	42	# Locate the bin
	43	print "Locating required external dependency bin:$bin...";
	44	my $found_bin = $self->can_run( $bin );
	45	if ( $found_bin ) {
	46	print " found at $found_bin.\n";
	47	} else {
	48	print " missing.\n";
	49	print "Unresolvable missing external dependency.\n";
	50	print "Please install '$bin' seperately and try again.\n";
	51	print STDERR "NA: Unable to build distribution on this platform.\n";
	52	exit(255);
	53	}
	54
	55	# Once we have some way to specify external deps, do it here.
	56	# In the mean time, continue as normal.
	57
	58	1;
	59	}
	60
	61	1;
	62
	63	__END__
	64
	65	#line 138

+93

-0

inc/Module/Install/Fetch.pm less more

	0	#line 1
	1	package Module::Install::Fetch;
	2
	3	use strict;
	4	use Module::Install::Base;
	5
	6	use vars qw{$VERSION $ISCORE @ISA};
	7	BEGIN {
	8	$VERSION = '0.67';
	9	$ISCORE = 1;
	10	@ISA = qw{Module::Install::Base};
	11	}
	12
	13	sub get_file {
	14	my ($self, %args) = @_;
	15	my ($scheme, $host, $path, $file) =
	16	$args{url} =~ m\|^(\w+)://([^/]+)(.+)/(.+)\| or return;
	17
	18	if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
	19	$args{url} = $args{ftp_url}
	20	or (warn("LWP support unavailable!\n"), return);
	21	($scheme, $host, $path, $file) =
	22	$args{url} =~ m\|^(\w+)://([^/]+)(.+)/(.+)\| or return;
	23	}
	24
	25	$\|++;
	26	print "Fetching '$file' from $host... ";
	27
	28	unless (eval { require Socket; Socket::inet_aton($host) }) {
	29	warn "'$host' resolve failed!\n";
	30	return;
	31	}
	32
	33	return unless $scheme eq 'ftp' or $scheme eq 'http';
	34
	35	require Cwd;
	36	my $dir = Cwd::getcwd();
	37	chdir $args{local_dir} or return if exists $args{local_dir};
	38
	39	if (eval { require LWP::Simple; 1 }) {
	40	LWP::Simple::mirror($args{url}, $file);
	41	}
	42	elsif (eval { require Net::FTP; 1 }) { eval {
	43	# use Net::FTP to get past firewall
	44	my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
	45	$ftp->login("anonymous", 'anonymous@example.com');
	46	$ftp->cwd($path);
	47	$ftp->binary;
	48	$ftp->get($file) or (warn("$!\n"), return);
	49	$ftp->quit;
	50	} }
	51	elsif (my $ftp = $self->can_run('ftp')) { eval {
	52	# no Net::FTP, fallback to ftp.exe
	53	require FileHandle;
	54	my $fh = FileHandle->new;
	55
	56	local $SIG{CHLD} = 'IGNORE';
	57	unless ($fh->open("\|$ftp -n")) {
	58	warn "Couldn't open ftp: $!\n";
	59	chdir $dir; return;
	60	}
	61
	62	my @dialog = split(/\n/, <<"END_FTP");
	63	open $host
	64	user anonymous anonymous\@example.com
	65	cd $path
	66	binary
	67	get $file $file
	68	quit
	69	END_FTP
	70	foreach (@dialog) { $fh->print("$_\n") }
	71	$fh->close;
	72	} }
	73	else {
	74	warn "No working 'ftp' program available!\n";
	75	chdir $dir; return;
	76	}
	77
	78	unless (-f $file) {
	79	warn "Fetching failed: $@\n";
	80	chdir $dir; return;
	81	}
	82
	83	return if exists $args{size} and -s $file != $args{size};
	84	system($args{run}) if exists $args{run};
	85	unlink($file) if $args{remove};
	86
	87	print(((!exists $args{check_for} or -e $args{check_for})
	88	? "done!" : "failed! ($!)"), "\n");
	89	chdir $dir; return !$?;
	90	}
	91
	92	1;

+34

-0

inc/Module/Install/Include.pm less more

	0	#line 1
	1	package Module::Install::Include;
	2
	3	use strict;
	4	use Module::Install::Base;
	5
	6	use vars qw{$VERSION $ISCORE @ISA};
	7	BEGIN {
	8	$VERSION = '0.67';
	9	$ISCORE = 1;
	10	@ISA = qw{Module::Install::Base};
	11	}
	12
	13	sub include {
	14	shift()->admin->include(@_);
	15	}
	16
	17	sub include_deps {
	18	shift()->admin->include_deps(@_);
	19	}
	20
	21	sub auto_include {
	22	shift()->admin->auto_include(@_);
	23	}
	24
	25	sub auto_include_deps {
	26	shift()->admin->auto_include_deps(@_);
	27	}
	28
	29	sub auto_include_dependent_dists {
	30	shift()->admin->auto_include_dependent_dists(@_);
	31	}
	32
	33	1;

+237

-0

inc/Module/Install/Makefile.pm less more

	0	#line 1
	1	package Module::Install::Makefile;
	2
	3	use strict 'vars';
	4	use Module::Install::Base;
	5	use ExtUtils::MakeMaker ();
	6
	7	use vars qw{$VERSION $ISCORE @ISA};
	8	BEGIN {
	9	$VERSION = '0.67';
	10	$ISCORE = 1;
	11	@ISA = qw{Module::Install::Base};
	12	}
	13
	14	sub Makefile { $_[0] }
	15
	16	my %seen = ();
	17
	18	sub prompt {
	19	shift;
	20
	21	# Infinite loop protection
	22	my @c = caller();
	23	if ( ++$seen{"$c[1]\|$c[2]\|$_[0]"} > 3 ) {
	24	die "Caught an potential prompt infinite loop ($c[1]\|$c[2]\|$_[0])";
	25	}
	26
	27	# In automated testing, always use defaults
	28	if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
	29	local $ENV{PERL_MM_USE_DEFAULT} = 1;
	30	goto &ExtUtils::MakeMaker::prompt;
	31	} else {
	32	goto &ExtUtils::MakeMaker::prompt;
	33	}
	34	}
	35
	36	sub makemaker_args {
	37	my $self = shift;
	38	my $args = ($self->{makemaker_args} \|\|= {});
	39	%$args = ( %$args, @_ ) if @_;
	40	$args;
	41	}
	42
	43	# For mm args that take multiple space-seperated args,
	44	# append an argument to the current list.
	45	sub makemaker_append {
	46	my $self = sShift;
	47	my $name = shift;
	48	my $args = $self->makemaker_args;
	49	$args->{name} = defined $args->{$name}
	50	? join( ' ', $args->{name}, @_ )
	51	: join( ' ', @_ );
	52	}
	53
	54	sub build_subdirs {
	55	my $self = shift;
	56	my $subdirs = $self->makemaker_args->{DIR} \|\|= [];
	57	for my $subdir (@_) {
	58	push @$subdirs, $subdir;
	59	}
	60	}
	61
	62	sub clean_files {
	63	my $self = shift;
	64	my $clean = $self->makemaker_args->{clean} \|\|= {};
	65	%$clean = (
	66	%$clean,
	67	FILES => join(' ', grep length, $clean->{FILES}, @_),
	68	);
	69	}
	70
	71	sub realclean_files {
	72	my $self = shift;
	73	my $realclean = $self->makemaker_args->{realclean} \|\|= {};
	74	%$realclean = (
	75	%$realclean,
	76	FILES => join(' ', grep length, $realclean->{FILES}, @_),
	77	);
	78	}
	79
	80	sub libs {
	81	my $self = shift;
	82	my $libs = ref $_[0] ? shift : [ shift ];
	83	$self->makemaker_args( LIBS => $libs );
	84	}
	85
	86	sub inc {
	87	my $self = shift;
	88	$self->makemaker_args( INC => shift );
	89	}
	90
	91	my %test_dir = ();
	92
	93	sub _wanted_t {
	94	/\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
	95	}
	96
	97	sub tests_recursive {
	98	my $self = shift;
	99	if ( $self->tests ) {
	100	die "tests_recursive will not work if tests are already defined";
	101	}
	102	my $dir = shift \|\| 't';
	103	unless ( -d $dir ) {
	104	die "tests_recursive dir '$dir' does not exist";
	105	}
	106	require File::Find;
	107	%test_dir = ();
	108	File::Find::find( \&_wanted_t, $dir );
	109	$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
	110	}
	111
	112	sub write {
	113	my $self = shift;
	114	die "&Makefile->write() takes no arguments\n" if @_;
	115
	116	my $args = $self->makemaker_args;
	117	$args->{DISTNAME} = $self->name;
	118	$args->{NAME} = $self->module_name \|\| $self->name \|\| $self->determine_NAME($args);
	119	$args->{VERSION} = $self->version \|\| $self->determine_VERSION($args);
	120	$args->{NAME} =~ s/-/::/g;
	121	if ( $self->tests ) {
	122	$args->{test} = { TESTS => $self->tests };
	123	}
	124	if ($] >= 5.005) {
	125	$args->{ABSTRACT} = $self->abstract;
	126	$args->{AUTHOR} = $self->author;
	127	}
	128	if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
	129	$args->{NO_META} = 1;
	130	}
	131	if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
	132	$args->{SIGN} = 1;
	133	}
	134	unless ( $self->is_admin ) {
	135	delete $args->{SIGN};
	136	}
	137
	138	# merge both kinds of requires into prereq_pm
	139	my $prereq = ($args->{PREREQ_PM} \|\|= {});
	140	%$prereq = ( %$prereq,
	141	map { @$_ }
	142	map { @$_ }
	143	grep $_,
	144	($self->build_requires, $self->requires)
	145	);
	146
	147	# merge both kinds of requires into prereq_pm
	148	my $subdirs = ($args->{DIR} \|\|= []);
	149	if ($self->bundles) {
	150	foreach my $bundle (@{ $self->bundles }) {
	151	my ($file, $dir) = @$bundle;
	152	push @$subdirs, $dir if -d $dir;
	153	delete $prereq->{$file};
	154	}
	155	}
	156
	157	if ( my $perl_version = $self->perl_version ) {
	158	eval "use $perl_version; 1"
	159	or die "ERROR: perl: Version $] is installed, "
	160	. "but we need version >= $perl_version";
	161	}
	162
	163	$args->{INSTALLDIRS} = $self->installdirs;
	164
	165	my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
	166
	167	my $user_preop = delete $args{dist}->{PREOP};
	168	if (my $preop = $self->admin->preop($user_preop)) {
	169	$args{dist} = $preop;
	170	}
	171
	172	my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
	173	$self->fix_up_makefile($mm->{FIRST_MAKEFILE} \|\| 'Makefile');
	174	}
	175
	176	sub fix_up_makefile {
	177	my $self = shift;
	178	my $makefile_name = shift;
	179	my $top_class = ref($self->_top) \|\| '';
	180	my $top_version = $self->_top->VERSION \|\| '';
	181
	182	my $preamble = $self->preamble
	183	? "# Preamble by $top_class $top_version\n"
	184	. $self->preamble
	185	: '';
	186	my $postamble = "# Postamble by $top_class $top_version\n"
	187	. ($self->postamble \|\| '');
	188
	189	local *MAKEFILE;
	190	open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
	191	my $makefile = do { local $/; <MAKEFILE> };
	192	close MAKEFILE or die $!;
	193
	194	$makefile =~ s/\b(test_harness$\$\(TEST_VERBOSE$, )/$1'inc', /;
	195	$makefile =~ s/( -I\$$INST_ARCHLIB$)/ -Iinc$1/g;
	196	$makefile =~ s/( "-I\$$INST_LIB$")/ "-Iinc"$1/g;
	197	$makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
	198	$makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
	199
	200	# Module::Install will never be used to build the Core Perl
	201	# Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
	202	# PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
	203	$makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
	204	#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
	205
	206	# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
	207	$makefile =~ s/("?)-I\$$PERL_LIB$\1//g;
	208
	209	# XXX - This is currently unused; not sure if it breaks other MM-users
	210	# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
	211
	212	open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
	213	print MAKEFILE "$preamble$makefile$postamble" or die $!;
	214	close MAKEFILE or die $!;
	215
	216	1;
	217	}
	218
	219	sub preamble {
	220	my ($self, $text) = @_;
	221	$self->{preamble} = $text . $self->{preamble} if defined $text;
	222	$self->{preamble};
	223	}
	224
	225	sub postamble {
	226	my ($self, $text) = @_;
	227	$self->{postamble} \|\|= $self->admin->postamble;
	228	$self->{postamble} .= $text if defined $text;
	229	$self->{postamble}
	230	}
	231
	232	1;
	233
	234	__END__
	235
	236	#line 363

+336

-0

inc/Module/Install/Metadata.pm less more

	0	#line 1
	1	package Module::Install::Metadata;
	2
	3	use strict 'vars';
	4	use Module::Install::Base;
	5
	6	use vars qw{$VERSION $ISCORE @ISA};
	7	BEGIN {
	8	$VERSION = '0.67';
	9	$ISCORE = 1;
	10	@ISA = qw{Module::Install::Base};
	11	}
	12
	13	my @scalar_keys = qw{
	14	name module_name abstract author version license
	15	distribution_type perl_version tests installdirs
	16	};
	17
	18	my @tuple_keys = qw{
	19	build_requires requires recommends bundles
	20	};
	21
	22	sub Meta { shift }
	23	sub Meta_ScalarKeys { @scalar_keys }
	24	sub Meta_TupleKeys { @tuple_keys }
	25
	26	foreach my $key (@scalar_keys) {
	27	*$key = sub {
	28	my $self = shift;
	29	return $self->{values}{$key} if defined wantarray and !@_;
	30	$self->{values}{$key} = shift;
	31	return $self;
	32	};
	33	}
	34
	35	foreach my $key (@tuple_keys) {
	36	*$key = sub {
	37	my $self = shift;
	38	return $self->{values}{$key} unless @_;
	39
	40	my @rv;
	41	while (@_) {
	42	my $module = shift or last;
	43	my $version = shift \|\| 0;
	44	if ( $module eq 'perl' ) {
	45	$version =~ s{^(\d+)\.(\d+)\.(\d+)}
	46	{$1 + $2/1_000 + $3/1_000_000}e;
	47	$self->perl_version($version);
	48	next;
	49	}
	50	my $rv = [ $module, $version ];
	51	push @rv, $rv;
	52	}
	53	push @{ $self->{values}{$key} }, @rv;
	54	@rv;
	55	};
	56	}
	57
	58	# configure_requires is currently a null-op
	59	sub configure_requires { 1 }
	60
	61	# Aliases for build_requires that will have alternative
	62	# meanings in some future version of META.yml.
	63	sub test_requires { shift->build_requires(@_) }
	64	sub install_requires { shift->build_requires(@_) }
	65
	66	# Aliases for installdirs options
	67	sub install_as_core { $_[0]->installdirs('perl') }
	68	sub install_as_cpan { $_[0]->installdirs('site') }
	69	sub install_as_site { $_[0]->installdirs('site') }
	70	sub install_as_vendor { $_[0]->installdirs('vendor') }
	71
	72	sub sign {
	73	my $self = shift;
	74	return $self->{'values'}{'sign'} if defined wantarray and ! @_;
	75	$self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
	76	return $self;
	77	}
	78
	79	sub dynamic_config {
	80	my $self = shift;
	81	unless ( @_ ) {
	82	warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n";
	83	return $self;
	84	}
	85	$self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0;
	86	return $self;
	87	}
	88
	89	sub all_from {
	90	my ( $self, $file ) = @_;
	91
	92	unless ( defined($file) ) {
	93	my $name = $self->name
	94	or die "all_from called with no args without setting name() first";
	95	$file = join('/', 'lib', split(/-/, $name)) . '.pm';
	96	$file =~ s{.*/}{} unless -e $file;
	97	die "all_from: cannot find $file from $name" unless -e $file;
	98	}
	99
	100	$self->version_from($file) unless $self->version;
	101	$self->perl_version_from($file) unless $self->perl_version;
	102
	103	# The remaining probes read from POD sections; if the file
	104	# has an accompanying .pod, use that instead
	105	my $pod = $file;
	106	if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) {
	107	$file = $pod;
	108	}
	109
	110	$self->author_from($file) unless $self->author;
	111	$self->license_from($file) unless $self->license;
	112	$self->abstract_from($file) unless $self->abstract;
	113	}
	114
	115	sub provides {
	116	my $self = shift;
	117	my $provides = ( $self->{values}{provides} \|\|= {} );
	118	%$provides = (%$provides, @_) if @_;
	119	return $provides;
	120	}
	121
	122	sub auto_provides {
	123	my $self = shift;
	124	return $self unless $self->is_admin;
	125
	126	unless (-e 'MANIFEST') {
	127	warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
	128	return $self;
	129	}
	130
	131	# Avoid spurious warnings as we are not checking manifest here.
	132
	133	local $SIG{__WARN__} = sub {1};
	134	require ExtUtils::Manifest;
	135	local *ExtUtils::Manifest::manicheck = sub { return };
	136
	137	require Module::Build;
	138	my $build = Module::Build->new(
	139	dist_name => $self->name,
	140	dist_version => $self->version,
	141	license => $self->license,
	142	);
	143	$self->provides(%{ $build->find_dist_packages \|\| {} });
	144	}
	145
	146	sub feature {
	147	my $self = shift;
	148	my $name = shift;
	149	my $features = ( $self->{values}{features} \|\|= [] );
	150
	151	my $mods;
	152
	153	if ( @_ == 1 and ref( $_[0] ) ) {
	154	# The user used ->feature like ->features by passing in the second
	155	# argument as a reference. Accomodate for that.
	156	$mods = $_[0];
	157	} else {
	158	$mods = \@_;
	159	}
	160
	161	my $count = 0;
	162	push @$features, (
	163	$name => [
	164	map {
	165	ref($_) ? ( ref($_) eq 'HASH' ) ? %$_
	166	: @$_
	167	: $_
	168	} @$mods
	169	]
	170	);
	171
	172	return @$features;
	173	}
	174
	175	sub features {
	176	my $self = shift;
	177	while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
	178	$self->feature( $name, @$mods );
	179	}
	180	return $self->{values}->{features}
	181	? @{ $self->{values}->{features} }
	182	: ();
	183	}
	184
	185	sub no_index {
	186	my $self = shift;
	187	my $type = shift;
	188	push @{ $self->{values}{no_index}{$type} }, @_ if $type;
	189	return $self->{values}{no_index};
	190	}
	191
	192	sub read {
	193	my $self = shift;
	194	$self->include_deps( 'YAML', 0 );
	195
	196	require YAML;
	197	my $data = YAML::LoadFile('META.yml');
	198
	199	# Call methods explicitly in case user has already set some values.
	200	while ( my ( $key, $value ) = each %$data ) {
	201	next unless $self->can($key);
	202	if ( ref $value eq 'HASH' ) {
	203	while ( my ( $module, $version ) = each %$value ) {
	204	$self->can($key)->($self, $module => $version );
	205	}
	206	}
	207	else {
	208	$self->can($key)->($self, $value);
	209	}
	210	}
	211	return $self;
	212	}
	213
	214	sub write {
	215	my $self = shift;
	216	return $self unless $self->is_admin;
	217	$self->admin->write_meta;
	218	return $self;
	219	}
	220
	221	sub version_from {
	222	my ( $self, $file ) = @_;
	223	require ExtUtils::MM_Unix;
	224	$self->version( ExtUtils::MM_Unix->parse_version($file) );
	225	}
	226
	227	sub abstract_from {
	228	my ( $self, $file ) = @_;
	229	require ExtUtils::MM_Unix;
	230	$self->abstract(
	231	bless(
	232	{ DISTNAME => $self->name },
	233	'ExtUtils::MM_Unix'
	234	)->parse_abstract($file)
	235	);
	236	}
	237
	238	sub _slurp {
	239	my ( $self, $file ) = @_;
	240
	241	local *FH;
	242	open FH, "< $file" or die "Cannot open $file.pod: $!";
	243	do { local $/; <FH> };
	244	}
	245
	246	sub perl_version_from {
	247	my ( $self, $file ) = @_;
	248
	249	if (
	250	$self->_slurp($file) =~ m/
	251	^
	252	use \s*
	253	v?
	254	([\d_\.]+)
	255	\s* ;
	256	/ixms
	257	)
	258	{
	259	my $v = $1;
	260	$v =~ s{_}{}g;
	261	$self->perl_version($1);
	262	}
	263	else {
	264	warn "Cannot determine perl version info from $file\n";
	265	return;
	266	}
	267	}
	268
	269	sub author_from {
	270	my ( $self, $file ) = @_;
	271	my $content = $self->_slurp($file);
	272	if ($content =~ m/
	273	=head \d \s+ (?:authors?)\b \s*
	274	([^\n]*)
	275	\|
	276	=head \d \s+ (?:licen[cs]e\|licensing\|copyright\|legal)\b \s*
	277	.? copyright .? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
	278	([^\n]*)
	279	/ixms) {
	280	my $author = $1 \|\| $2;
	281	$author =~ s{E<lt>}{<}g;
	282	$author =~ s{E<gt>}{>}g;
	283	$self->author($author);
	284	}
	285	else {
	286	warn "Cannot determine author info from $file\n";
	287	}
	288	}
	289
	290	sub license_from {
	291	my ( $self, $file ) = @_;
	292
	293	if (
	294	$self->_slurp($file) =~ m/
	295	(
	296	=head \d \s+
	297	(?:licen[cs]e\|licensing\|copyright\|legal)\b
	298	.*?
	299	)
	300	(=head\\d.\|=cut.\|)
	301	\z
	302	/ixms
	303	)
	304	{
	305	my $license_text = $1;
	306	my @phrases = (
	307	'under the same (?:terms\|license) as perl itself' => 'perl', 1,
	308	'GNU public license' => 'gpl', 1,
	309	'GNU lesser public license' => 'gpl', 1,
	310	'BSD license' => 'bsd', 1,
	311	'Artistic license' => 'artistic', 1,
	312	'GPL' => 'gpl', 1,
	313	'LGPL' => 'lgpl', 1,
	314	'BSD' => 'bsd', 1,
	315	'Artistic' => 'artistic', 1,
	316	'MIT' => 'mit', 1,
	317	'proprietary' => 'proprietary', 0,
	318	);
	319	while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
	320	$pattern =~ s{\s+}{\\s+}g;
	321	if ( $license_text =~ /\b$pattern\b/i ) {
	322	if ( $osi and $license_text =~ /All rights reserved/i ) {
	323	warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it.";
	324	}
	325	$self->license($license);
	326	return 1;
	327	}
	328	}
	329	}
	330
	331	warn "Cannot determine license info from $file\n";
	332	return 'unknown';
	333	}
	334
	335	1;

+65

-0

inc/Module/Install/Win32.pm less more

	0	#line 1
	1	package Module::Install::Win32;
	2
	3	use strict;
	4	use Module::Install::Base;
	5
	6	use vars qw{$VERSION $ISCORE @ISA};
	7	BEGIN {
	8	$VERSION = '0.67';
	9	$ISCORE = 1;
	10	@ISA = qw{Module::Install::Base};
	11	}
	12
	13	# determine if the user needs nmake, and download it if needed
	14	sub check_nmake {
	15	my $self = shift;
	16	$self->load('can_run');
	17	$self->load('get_file');
	18
	19	require Config;
	20	return unless (
	21	$^O eq 'MSWin32' and
	22	$Config::Config{make} and
	23	$Config::Config{make} =~ /^nmake\b/i and
	24	! $self->can_run('nmake')
	25	);
	26
	27	print "The required 'nmake' executable not found, fetching it...\n";
	28
	29	require File::Basename;
	30	my $rv = $self->get_file(
	31	url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
	32	ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
	33	local_dir => File::Basename::dirname($^X),
	34	size => 51928,
	35	run => 'Nmake15.exe /o > nul',
	36	check_for => 'Nmake.exe',
	37	remove => 1,
	38	);
	39
	40	if (!$rv) {
	41	die <<'END_MESSAGE';
	42
	43	-------------------------------------------------------------------------------
	44
	45	Since you are using Microsoft Windows, you will need the 'nmake' utility
	46	before installation. It's available at:
	47
	48	http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
	49	or
	50	ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
	51
	52	Please download the file manually, save it to a directory in %PATH% (e.g.
	53	C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
	54	that directory, and run "Nmake15.exe" from there; that will create the
	55	'nmake.exe' file needed by this module.
	56
	57	You may then resume the installation process described in README.
	58
	59	-------------------------------------------------------------------------------
	60	END_MESSAGE
	61	}
	62	}
	63
	64	1;

+43

-0

inc/Module/Install/WriteAll.pm less more

	0	#line 1
	1	package Module::Install::WriteAll;
	2
	3	use strict;
	4	use Module::Install::Base;
	5
	6	use vars qw{$VERSION $ISCORE @ISA};
	7	BEGIN {
	8	$VERSION = '0.67';
	9	$ISCORE = 1;
	10	@ISA = qw{Module::Install::Base};
	11	}
	12
	13	sub WriteAll {
	14	my $self = shift;
	15	my %args = (
	16	meta => 1,
	17	sign => 0,
	18	inline => 0,
	19	check_nmake => 1,
	20	@_
	21	);
	22
	23	$self->sign(1) if $args{sign};
	24	$self->Meta->write if $args{meta};
	25	$self->admin->WriteAll(%args) if $self->is_admin;
	26
	27	if ( $0 =~ /Build.PL$/i ) {
	28	$self->Build->write;
	29	} else {
	30	$self->check_nmake if $args{check_nmake};
	31	unless ( $self->makemaker_args->{'PL_FILES'} ) {
	32	$self->makemaker_args( PL_FILES => {} );
	33	}
	34	if ($args{inline}) {
	35	$self->Inline->write;
	36	} else {
	37	$self->Makefile->write;
	38	}
	39	}
	40	}
	41
	42	1;

+281

-0

inc/Module/Install.pm less more

	0	#line 1
	1	package Module::Install;
	2
	3	# For any maintainers:
	4	# The load order for Module::Install is a bit magic.
	5	# It goes something like this...
	6	#
	7	# IF ( host has Module::Install installed, creating author mode ) {
	8	# 1. Makefile.PL calls "use inc::Module::Install"
	9	# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
	10	# 3. The installed version of inc::Module::Install loads
	11	# 4. inc::Module::Install calls "require Module::Install"
	12	# 5. The ./inc/ version of Module::Install loads
	13	# } ELSE {
	14	# 1. Makefile.PL calls "use inc::Module::Install"
	15	# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
	16	# 3. The ./inc/ version of Module::Install loads
	17	# }
	18
	19	use 5.004;
	20	use strict 'vars';
	21
	22	use vars qw{$VERSION};
	23	BEGIN {
	24	# All Module::Install core packages now require synchronised versions.
	25	# This will be used to ensure we don't accidentally load old or
	26	# different versions of modules.
	27	# This is not enforced yet, but will be some time in the next few
	28	# releases once we can make sure it won't clash with custom
	29	# Module::Install extensions.
	30	$VERSION = '0.67';
	31	}
	32
	33	# Whether or not inc::Module::Install is actually loaded, the
	34	# $INC{inc/Module/Install.pm} is what will still get set as long as
	35	# the caller loaded module this in the documented manner.
	36	# If not set, the caller may NOT have loaded the bundled version, and thus
	37	# they may not have a MI version that works with the Makefile.PL. This would
	38	# result in false errors or unexpected behaviour. And we don't want that.
	39	my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
	40	unless ( $INC{$file} ) {
	41	die <<"END_DIE";
	42	Please invoke ${\__PACKAGE__} with:
	43
	44	use inc::${\__PACKAGE__};
	45
	46	not:
	47
	48	use ${\__PACKAGE__};
	49
	50	END_DIE
	51	}
	52
	53	# If the script that is loading Module::Install is from the future,
	54	# then make will detect this and cause it to re-run over and over
	55	# again. This is bad. Rather than taking action to touch it (which
	56	# is unreliable on some platforms and requires write permissions)
	57	# for now we should catch this and refuse to run.
	58	if ( -f $0 and (stat($0))[9] > time ) {
	59	die << "END_DIE";
	60	Your installer $0 has a modification time in the future.
	61
	62	This is known to create infinite loops in make.
	63
	64	Please correct this, then run $0 again.
	65
	66	END_DIE
	67	}
	68
	69	use Cwd ();
	70	use File::Find ();
	71	use File::Path ();
	72	use FindBin;
	73
	74	inc::Module::Install::VERSION = VERSION;
	75	@inc::Module::Install::ISA = __PACKAGE__;
	76
	77	sub autoload {
	78	my $self = shift;
	79	my $who = $self->_caller;
	80	my $cwd = Cwd::cwd();
	81	my $sym = "${who}::AUTOLOAD";
	82	$sym->{$cwd} = sub {
	83	my $pwd = Cwd::cwd();
	84	if ( my $code = $sym->{$pwd} ) {
	85	# delegate back to parent dirs
	86	goto &$code unless $cwd eq $pwd;
	87	}
	88	$$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
	89	unshift @_, ($self, $1);
	90	goto &{$self->can('call')} unless uc($1) eq $1;
	91	};
	92	}
	93
	94	sub import {
	95	my $class = shift;
	96	my $self = $class->new(@_);
	97	my $who = $self->_caller;
	98
	99	unless ( -f $self->{file} ) {
	100	require "$self->{path}/$self->{dispatch}.pm";
	101	File::Path::mkpath("$self->{prefix}/$self->{author}");
	102	$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
	103	$self->{admin}->init;
	104	@_ = ($class, _self => $self);
	105	goto &{"$self->{name}::import"};
	106	}
	107
	108	*{"${who}::AUTOLOAD"} = $self->autoload;
	109	$self->preload;
	110
	111	# Unregister loader and worker packages so subdirs can use them again
	112	delete $INC{"$self->{file}"};
	113	delete $INC{"$self->{path}.pm"};
	114	}
	115
	116	sub preload {
	117	my ($self) = @_;
	118
	119	unless ( $self->{extensions} ) {
	120	$self->load_extensions(
	121	"$self->{prefix}/$self->{path}", $self
	122	);
	123	}
	124
	125	my @exts = @{$self->{extensions}};
	126	unless ( @exts ) {
	127	my $admin = $self->{admin};
	128	@exts = $admin->load_all_extensions;
	129	}
	130
	131	my %seen;
	132	foreach my $obj ( @exts ) {
	133	while (my ($method, $glob) = each %{ref($obj) . '::'}) {
	134	next unless $obj->can($method);
	135	next if $method =~ /^_/;
	136	next if $method eq uc($method);
	137	$seen{$method}++;
	138	}
	139	}
	140
	141	my $who = $self->_caller;
	142	foreach my $name ( sort keys %seen ) {
	143	*{"${who}::$name"} = sub {
	144	${"${who}::AUTOLOAD"} = "${who}::$name";
	145	goto &{"${who}::AUTOLOAD"};
	146	};
	147	}
	148	}
	149
	150	sub new {
	151	my ($class, %args) = @_;
	152
	153	# ignore the prefix on extension modules built from top level.
	154	my $base_path = Cwd::abs_path($FindBin::Bin);
	155	unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
	156	delete $args{prefix};
	157	}
	158
	159	return $args{_self} if $args{_self};
	160
	161	$args{dispatch} \|\|= 'Admin';
	162	$args{prefix} \|\|= 'inc';
	163	$args{author} \|\|= ($^O eq 'VMS' ? '_author' : '.author');
	164	$args{bundle} \|\|= 'inc/BUNDLES';
	165	$args{base} \|\|= $base_path;
	166	$class =~ s/^\Q$args{prefix}\E:://;
	167	$args{name} \|\|= $class;
	168	$args{version} \|\|= $class->VERSION;
	169	unless ( $args{path} ) {
	170	$args{path} = $args{name};
	171	$args{path} =~ s!::!/!g;
	172	}
	173	$args{file} \|\|= "$args{base}/$args{prefix}/$args{path}.pm";
	174
	175	bless( \%args, $class );
	176	}
	177
	178	sub call {
	179	my ($self, $method) = @_;
	180	my $obj = $self->load($method) or return;
	181	splice(@_, 0, 2, $obj);
	182	goto &{$obj->can($method)};
	183	}
	184
	185	sub load {
	186	my ($self, $method) = @_;
	187
	188	$self->load_extensions(
	189	"$self->{prefix}/$self->{path}", $self
	190	) unless $self->{extensions};
	191
	192	foreach my $obj (@{$self->{extensions}}) {
	193	return $obj if $obj->can($method);
	194	}
	195
	196	my $admin = $self->{admin} or die <<"END_DIE";
	197	The '$method' method does not exist in the '$self->{prefix}' path!
	198	Please remove the '$self->{prefix}' directory and run $0 again to load it.
	199	END_DIE
	200
	201	my $obj = $admin->load($method, 1);
	202	push @{$self->{extensions}}, $obj;
	203
	204	$obj;
	205	}
	206
	207	sub load_extensions {
	208	my ($self, $path, $top) = @_;
	209
	210	unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
	211	unshift @INC, $self->{prefix};
	212	}
	213
	214	foreach my $rv ( $self->find_extensions($path) ) {
	215	my ($file, $pkg) = @{$rv};
	216	next if $self->{pathnames}{$pkg};
	217
	218	local $@;
	219	my $new = eval { require $file; $pkg->can('new') };
	220	unless ( $new ) {
	221	warn $@ if $@;
	222	next;
	223	}
	224	$self->{pathnames}{$pkg} = delete $INC{$file};
	225	push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
	226	}
	227
	228	$self->{extensions} \|\|= [];
	229	}
	230
	231	sub find_extensions {
	232	my ($self, $path) = @_;
	233
	234	my @found;
	235	File::Find::find( sub {
	236	my $file = $File::Find::name;
	237	return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
	238	my $subpath = $1;
	239	return if lc($subpath) eq lc($self->{dispatch});
	240
	241	$file = "$self->{path}/$subpath.pm";
	242	my $pkg = "$self->{name}::$subpath";
	243	$pkg =~ s!/!::!g;
	244
	245	# If we have a mixed-case package name, assume case has been preserved
	246	# correctly. Otherwise, root through the file to locate the case-preserved
	247	# version of the package name.
	248	if ( $subpath eq lc($subpath) \|\| $subpath eq uc($subpath) ) {
	249	open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!";
	250	my $in_pod = 0;
	251	while ( <PKGFILE> ) {
	252	$in_pod = 1 if /^=\w/;
	253	$in_pod = 0 if /^=cut/;
	254	next if ($in_pod \|\| /^=cut/); # skip pod text
	255	next if /^\s*#/; # and comments
	256	if ( m/^\spackage\s+($pkg)\s;/i ) {
	257	$pkg = $1;
	258	last;
	259	}
	260	}
	261	close PKGFILE;
	262	}
	263
	264	push @found, [ $file, $pkg ];
	265	}, $path ) if -d $path;
	266
	267	@found;
	268	}
	269
	270	sub _caller {
	271	my $depth = 0;
	272	my $call = caller($depth);
	273	while ( $call eq __PACKAGE__ ) {
	274	$depth++;
	275	$call = caller($depth);
	276	}
	277	return $call;
	278	}
	279
	280	1;