Commit 339427167fcd1f3dc1b2a62be575b1044e6c6c6c - libclass-c3-xs-perl

+15

-0

ChangeLog less more

0	0	Revision history for Perl extension Class::C3::XS
	1
	2	0.13 Thu Sep 24, 2009
	3	- Release 0.12_03 as a stable release, without further modifications.
	4
	5	0.12_03 Mon Sep 21, 2009
	6	- Fix compatibility with perl 5.6.x. Thanks again, Nicholas.
	7
	8	0.12_02 Mon Sep 7, 2009
	9	- Actually ship with the changes 0.12_01 claimed to have. Thanks for
	10	catching this, Nicholas.
	11
	12	0.12_01 Sat Aug 22, 2009
	13	- Backport a couple of performance tweaks from bleadperl. This gives a
	14	performance improvement of about 40% in calculating the linearized
	15	isa for hierarchies with single parents only.
1	16
2	17	0.11 Mon Mar 30, 2009
3	18	- Define SVfARG if the perl we're compiling for doesn't have

+5

-4

META.yml less more

2	2	author:
3	3	- 'Brandon L. Black, <blblack@gmail.com>'
4	4	build_requires:
	5	ExtUtils::MakeMaker: 6.42
5	6	Test::More: 0.47
6	7	configure_requires:
7		ExtUtils::MakeMaker: 6.50
	8	ExtUtils::MakeMaker: 6.42
8	9	distribution_type: module
9		generated_by: 'Module::Install version 0.81'
	10	generated_by: 'Module::Install version 0.91'
10	11	license: perl
11	12	meta-spec:
12	13	url: http://module-build.sourceforge.net/META-spec-v1.4.html

19	20	provides:
20	21	Class::C3::XS:
21	22	file: lib/Class/C3/XS.pm
22		version: 0.11
	23	version: 0.13
23	24	requires:
24	25	perl: 5.6.0
25	26	resources:
26	27	license: http://dev.perl.org/licenses/
27		version: 0.11
	28	version: 0.13

+66

-14

XS.xs less more

98	98	if(isa && AvFILLp(isa) >= 0) {
99	99	SV** seqs_ptr;
100	100	I32 seqs_items;
101		HV* const tails = (HV)sv_2mortal((SV)newHV());
	101	HV* tails;
102	102	AV* const seqs = (AV)sv_2mortal((SV)newAV());
103	103	I32* heads;
104	104

121	121	else {
122	122	/* recursion */
123	123	AV* const isa_lin = __mro_linear_isa_c3(aTHX_ isa_item_stash, cache, level + 1);
	124
	125	if(items == 0 && AvFILLp(seqs) == -1) {
	126	/* Only one parent class. For this case, the C3
	127	linearisation is this class followed by the parent's
	128	linearisation, so don't bother with the expensive
	129	calculation. */
	130	SV **svp;
	131	I32 subrv_items = AvFILLp(isa_lin) + 1;
	132	SV const subrv_p = AvARRAY(isa_lin);
	133
	134	/* Hijack the allocated but unused array seqs to be the
	135	return value. It's currently mortalised. */
	136
	137	retval = seqs;
	138
	139	av_extend(retval, subrv_items);
	140	AvFILLp(retval) = subrv_items;
	141	svp = AvARRAY(retval);
	142
	143	/* First entry is this class. */
	144	*svp++ = newSVpvn(stashname, stashname_len);
	145
	146	while(subrv_items--) {
	147	/* These values are unlikely to be shared hash key
	148	scalars, so no point in adding code to optimising
	149	for a case that is unlikely to be true.
	150	(Or prove me wrong and do it.) */
	151
	152	SV const val = subrv_p++;
	153	*svp++ = newSVsv(val);
	154	}
	155
	156	SvREFCNT_dec(isa_lin);
	157	SvREFCNT_inc(retval);
	158
	159	goto done;
	160	}
124	161	av_push(seqs, (SV*)isa_lin);
125	162	}
126	163	}
127	164	av_push(seqs, SvREFCNT_inc((SV*)isa));
	165	tails = (HV)sv_2mortal((SV)newHV());
128	166
129	167	/* This builds "heads", which as an array of integer array
130	168	indices, one per seq, which point at the virtual "head"

145	183	SV** seq_ptr = AvARRAY(seq) + 1;
146	184	while(seq_items--) {
147	185	SV* const seqitem = *seq_ptr++;
148		HE* const he = hv_fetch_ent(tails, seqitem, 0, 0);
149		if(!he) {
150		if(!hv_store_ent(tails, seqitem, newSViv(1), 0)) {
151		croak("failed to store value in hash");
	186	/* LVALUE fetch will create a new undefined SV if necessary
	187	*/
	188	HE* const he = hv_fetch_ent(tails, seqitem, 1, 0);
	189	if(he) {
	190	SV* const val = HeVAL(he);
	191	/* For 5.8.0 and later, sv_inc() with increment undef to
	192	an IV of 1, which is what we want for a newly created
	193	entry. However, for 5.6.x it will become an NV of
	194	1.0, which confuses the SvIVX() checks above */
	195	if(SvIOK(val)) {
	196	SvIVX(val)++;
	197	} else {
	198	sv_setiv(val, 1);
152	199	}
153		}
154		else {
155		SV* const val = HeVAL(he);
156		sv_inc(val);
	200	} else {
	201	croak("failed to store value in hash");
157	202	}
158	203	}
159	204	}

259	304	av_push(retval, newSVpvn(stashname, stashname_len));
260	305	}
261	306
	307	done:
262	308	/* we don't want anyone modifying the cache entry but us,
263	309	and we do so by replacing it completely */
264	310	SvREADONLY_on(retval);

366	412	}
367	413
368	414	/* we found a real sub here */
369		sv = sv_2mortal(newSV(0));
	415	sv = sv_newmortal();
370	416
371	417	gv_efullname3(sv, cvgv, NULL);
372	418
373		fq_subname = SvPVX(sv);
374		fq_subname_len = SvCUR(sv);
	419	if (SvPOK(sv)) {
	420	fq_subname = SvPVX(sv);
	421	fq_subname_len = SvCUR(sv);
	422
	423	subname = strrchr(fq_subname, ':');
	424	} else {
	425	subname = NULL;
	426	}
375	427
376	428	subname = strrchr(fq_subname, ':');
377	429	if(!subname)

473	525	if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
474	526	SvREFCNT_dec(linear_av);
475	527	SvREFCNT_inc((SV*)cand_cv);
476		if (!hv_store_ent(nmcache, newSVsv(cachekey), (SV*)cand_cv, 0)) {
	528	if (!hv_store_ent(nmcache, cachekey, (SV*)cand_cv, 0)) {
477	529	croak("failed to store value in hash");
478	530	}
479	531	XPUSHs(sv_2mortal(newRV_inc((SV*)cand_cv)));

483	535	}
484	536
485	537	SvREFCNT_dec(linear_av);
486		if (!hv_store_ent(nmcache, newSVsv(cachekey), &PL_sv_undef, 0)) {
	538	if (!hv_store_ent(nmcache, cachekey, &PL_sv_undef, 0)) {
487	539	croak("failed to store value in hash");
488	540	}
489	541	if(throw_nomethod)

+14

-2

debian/changelog less more

0		libclass-c3-xs-perl (0.11-2) UNRELEASED; urgency=low
	0	libclass-c3-xs-perl (0.13-1) UNRELEASED; urgency=low
1	1
	2	[ Jonathan Yu ]
	3	* New upstream release
	4	* Add myself to Uploaders and Copyright
	5	* Upgrade to new short debhelper rules format
	6	* Refresh copyright file
	7	* Standards-Version 3.8.3 (drop perl version dependency)
	8	* Rewrite control description
	9	* Now Recommends libclass-c3-xs-perl -- this should probably become
	10	Depends, but I'm not sure. It can technically be used on its own,
	11	but it is not intended to be.
	12
	13	[ Nathan Handler ]
2	14	* debian/watch: Update to ignore development releases.
3	15
4		-- Nathan Handler <nhandler@ubuntu.com> Sat, 06 Jun 2009 01:33:07 +0000
	16	-- Jonathan Yu <jawnsy@cpan.org> Fri, 25 Sep 2009 05:11:56 -0400
5	17
6	18	libclass-c3-xs-perl (0.11-1) unstable; urgency=low
7	19

+9

-7

debian/control less more

0	0	Source: libclass-c3-xs-perl
1	1	Section: perl
2	2	Priority: optional
3		Build-Depends: debhelper (>= 7), perl (>= 5.8.8-7), libtest-pod-perl
	3	Build-Depends: perl, debhelper (>= 7), libtest-pod-perl
4	4	Maintainer: Debian Perl Group <pkg-perl-maintainers@lists.alioth.debian.org>
5	5	Uploaders: Krzysztof Krzyżaniak (eloy) <eloy@debian.org>,
6		Damyan Ivanov <dmn@debian.org>
7		Standards-Version: 3.8.1
	6	Damyan Ivanov <dmn@debian.org>, Jonathan Yu <jawnsy@cpan.org>
	7	Standards-Version: 3.8.3
8	8	Homepage: http://search.cpan.org/dist/Class-C3-XS/
9	9	Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libclass-c3-xs-perl/
10	10	Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libclass-c3-xs-perl/

12	12	Package: libclass-c3-xs-perl
13	13	Architecture: any
14	14	Depends: ${misc:Depends}, ${perl:Depends}, ${shlibs:Depends}
15		Description: XS speedups for Class::C3
16		Class::C3::XS contains XS performance enhancers for Class::C3 version 0.16
17		and higher. The main Class::C3 package will use this package automatically
18		if it can find it. Do not use this package directly, use Class::C3 instead.
	15	Recommends: libclass-c3-perl (>= 0.16)
	16	Description: Perl module to accelerate Class::C3
	17	Class::C3::XS is a Perl module designed to enhance the performance of the
	18	Class::C3 package (see libclass-c3-perl). It does so automatically and is not
	19	designed to be used directly; once installed, it should accelerate all programs
	20	that make use of Class::C3 itself.

+29

-25

debian/copyright less more

0	0	Format-Specification:
1	1	http://wiki.debian.org/Proposals/CopyrightFormat?action=recall&rev=196
2		Upstream-Maintainer: Brandon L. Black
	2	Upstream-Maintainer: Florian Ragwitz <rafl@debian.org>
3	3	Upstream-Source: http://search.cpan.org/dist/Class-C3-XS/
4	4	Upstream-Name: Class-C3-XS
5	5
6	6	Files: *
7		Author: Brandon L. Black, <blblack@gmail.com>
	7	Author: Brandon L. Black <blblack@gmail.com>
8	8	Copyright: no explicit copyright. ChangeLog shows that the module was
9	9	developed during 2007 and 2009
10		License: GPL-1+\|Artistic
11		This library is free software; you can redistribute it and/or modify
12		it under the same terms as Perl itself.
13		.
14		Perl is distributed under licenses:
15		.
16		a) the GNU General Public License as published by the Free Software
17		Foundation; either version 1, or (at your option) any later
18		version, or
19		.
20		b) the "Artistic License" which comes with Perl.
21		.
22		On Debian GNU/Linux systems, the complete text of the GNU General Public
23		License can be found in /usr/share/common-licenses/GPL' and the Artistic
24		Licence in /usr/share/common-licenses/Artistic'.
	10	License: GPL-1+ \| Artistic
25	11
26		Files: inc/*
27		Copyright: 2002 - 2009 by Brian Ingerson, Audrey Tang and Adam Kennedy.
	12	Files: debian/*
	13	Copyright: 2009, Jonathan Yu <jawnsy@cpan.org>
	14	2008, Damyan Ivanov <dmn@debian.org>
	15	2007-2009, Krzysztof Krzyzaniak (eloy) <eloy@debian.org>
	16	License: GPL-1+ \| Artistic
	17	X-Comment: It is assumed that all maintainers license their work as the
	18	same as upstream.
	19
	20	Files: inc/Module/*
	21	Copyright: 2002-2009, Adam Kennedy <adamk@cpan.org>
	22	2002-2009, Audrey Tang <autrijus@autrijus.org>
	23	2002-2009, Brian Ingerson <ingy@cpan.org>
28	24	License-Alias: Perl
29	25	License: Artistic \| GPL-1+
30	26
31		Files: debian/*
32		Copyright: © 2007-2009 Krzysztof Krzyzaniak (eloy) <eloy@debian.org>
33		Copyright: © 2007-2009 Debian Perl Group <debian-perl@lists.debian.org>
34		License: other
35		It is assumed that all maintainers license their worh in a manner, compatible
36		with upstream's license.
	27	License: Artistic
	28	This program is free software; you can redistribute it and/or modify
	29	it under the terms of the Artistic License, which comes with Perl.
	30	On Debian GNU/Linux systems, the complete text of the Artistic License
	31	can be found in `/usr/share/common-licenses/Artistic'
	32
	33	License: GPL-1+
	34	This program is free software; you can redistribute it and/or modify
	35	it under the terms of the GNU General Public License as published by
	36	the Free Software Foundation; either version 1, or (at your option)
	37	any later version.
	38	On Debian GNU/Linux systems, the complete text of the GNU General
	39	Public License can be found in `/usr/share/common-licenses/GPL'
	40

+1

-20

debian/rules less more

0	0	#!/usr/bin/make -f
1	1
2		build: build-stamp
3		build-stamp:
4		dh build
5		touch $@
6
7		clean:
	2	%:
8	3	dh $@
9
10		install: install-stamp
11		install-stamp: build-stamp
12		dh install
13		touch $@
14
15		binary-arch: install
16		dh $@
17
18		binary-indep:
19
20		binary: binary-arch binary-indep
21
22		.PHONY: binary binary-arch binary-indep install clean build

+33

-27

inc/Module/Install/Base.pm less more

0	0	#line 1
1	1	package Module::Install::Base;
2	2
3		$VERSION = '0.81';
	3	use strict 'vars';
	4	use vars qw{$VERSION};
	5	BEGIN {
	6	$VERSION = '0.91';
	7	}
4	8
5	9	# Suspend handler for "redefined" warnings
6	10	BEGIN {

8	12	$SIG{__WARN__} = sub { $w };
9	13	}
10	14
11		### This is the ONLY module that shouldn't have strict on
12		# use strict;
13
14		#line 41
	15	#line 42
15	16
16	17	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 );
	18	my $class = shift;
	19	unless ( defined &{"${class}::call"} ) {
	20	*{"${class}::call"} = sub { shift->_top->call(@_) };
	21	}
	22	unless ( defined &{"${class}::load"} ) {
	23	*{"${class}::load"} = sub { shift->_top->load(@_) };
	24	}
	25	bless { @_ }, $class;
26	26	}
27	27
28	28	#line 61
29	29
30	30	sub AUTOLOAD {
31		my $self = shift;
32		local $@;
33		my $autoload = eval { $self->_top->autoload } or return;
34		goto &$autoload;
	31	local $@;
	32	my $func = eval { shift->_top->autoload } or return;
	33	goto &$func;
35	34	}
36	35
37		#line 76
	36	#line 75
38	37
39		sub _top { $_[0]->{_top} }
	38	sub _top {
	39	$_[0]->{_top};
	40	}
40	41
41		#line 89
	42	#line 90
42	43
43	44	sub admin {
44		$_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new;
	45	$_[0]->_top->{admin}
	46	or
	47	Module::Install::Base::FakeAdmin->new;
45	48	}
46	49
47		#line 101
	50	#line 106
48	51
49	52	sub is_admin {
50		$_[0]->admin->VERSION;
	53	$_[0]->admin->VERSION;
51	54	}
52	55
53	56	sub DESTROY {}
54	57
55	58	package Module::Install::Base::FakeAdmin;
56	59
57		my $Fake;
58		sub new { $Fake \|\|= bless(\@_, $_[0]) }
	60	my $fake;
	61
	62	sub new {
	63	$fake \|\|= bless(\@_, $_[0]);
	64	}
59	65
60	66	sub AUTOLOAD {}
61	67

68	74
69	75	1;
70	76
71		#line 146
	77	#line 154

+7

-7

inc/Module/Install/Can.pm less more

1	1	package Module::Install::Can;
2	2
3	3	use strict;
4		use Module::Install::Base;
5		use Config ();
6		use File::Spec ();
7		use ExtUtils::MakeMaker ();
	4	use Config ();
	5	use File::Spec ();
	6	use ExtUtils::MakeMaker ();
	7	use Module::Install::Base ();
8	8
9		use vars qw{$VERSION $ISCORE @ISA};
	9	use vars qw{$VERSION @ISA $ISCORE};
10	10	BEGIN {
11		$VERSION = '0.81';
	11	$VERSION = '0.91';
	12	@ISA = 'Module::Install::Base';
12	13	$ISCORE = 1;
13		@ISA = qw{Module::Install::Base};
14	14	}
15	15
16	16	# check if we can load some module

+4

-4

inc/Module/Install/Fetch.pm less more

1	1	package Module::Install::Fetch;
2	2
3	3	use strict;
4		use Module::Install::Base;
	4	use Module::Install::Base ();
5	5
6		use vars qw{$VERSION $ISCORE @ISA};
	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '0.81';
	8	$VERSION = '0.91';
	9	@ISA = 'Module::Install::Base';
9	10	$ISCORE = 1;
10		@ISA = qw{Module::Install::Base};
11	11	}
12	12
13	13	sub get_file {

+33

-18

inc/Module/Install/Makefile.pm less more

1	1	package Module::Install::Makefile;
2	2
3	3	use strict 'vars';
4		use Module::Install::Base;
5		use ExtUtils::MakeMaker ();
6
7		use vars qw{$VERSION $ISCORE @ISA};
	4	use ExtUtils::MakeMaker ();
	5	use Module::Install::Base ();
	6
	7	use vars qw{$VERSION @ISA $ISCORE};
8	8	BEGIN {
9		$VERSION = '0.81';
	9	$VERSION = '0.91';
	10	@ISA = 'Module::Install::Base';
10	11	$ISCORE = 1;
11		@ISA = qw{Module::Install::Base};
12	12	}
13	13
14	14	sub Makefile { $_[0] }

113	113	my $self = shift;
114	114	die "&Makefile->write() takes no arguments\n" if @_;
115	115
116		# Make sure we have a new enough
	116	# Check the current Perl version
	117	my $perl_version = $self->perl_version;
	118	if ( $perl_version ) {
	119	eval "use $perl_version; 1"
	120	or die "ERROR: perl: Version $] is installed, "
	121	. "but we need version >= $perl_version";
	122	}
	123
	124	# Make sure we have a new enough MakeMaker
117	125	require ExtUtils::MakeMaker;
118	126
119		# MakeMaker can complain about module versions that include
120		# an underscore, even though its own version may contain one!
121		# Hence the funny regexp to get rid of it. See RT #35800
122		# for details.
123
124		$self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
125
126		# Generate the
	127	if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
	128	# MakeMaker can complain about module versions that include
	129	# an underscore, even though its own version may contain one!
	130	# Hence the funny regexp to get rid of it. See RT #35800
	131	# for details.
	132	$self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
	133	$self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
	134	} else {
	135	# Allow legacy-compatibility with 5.005 by depending on the
	136	# most recent EU:MM that supported 5.005.
	137	$self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
	138	$self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
	139	}
	140
	141	# Generate the MakeMaker params
127	142	my $args = $self->makemaker_args;
128	143	$args->{DISTNAME} = $self->name;
129	144	$args->{NAME} = $self->module_name \|\| $self->name;

132	147	if ( $self->tests ) {
133	148	$args->{test} = { TESTS => $self->tests };
134	149	}
135		if ($] >= 5.005) {
	150	if ( $] >= 5.005 ) {
136	151	$args->{ABSTRACT} = $self->abstract;
137	152	$args->{AUTHOR} = $self->author;
138	153	}

146	161	delete $args->{SIGN};
147	162	}
148	163
149		# merge both kinds of requires into prereq_pm
	164	# Merge both kinds of requires into prereq_pm
150	165	my $prereq = ($args->{PREREQ_PM} \|\|= {});
151	166	%$prereq = ( %$prereq,
152	167	map { @$_ }

249	264
250	265	__END__
251	266
252		#line 379
	267	#line 394

+75

-31

inc/Module/Install/Metadata.pm less more

1	1	package Module::Install::Metadata;
2	2
3	3	use strict 'vars';
4		use Module::Install::Base;
	4	use Module::Install::Base ();
5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '0.81';
9		@ISA = qw{Module::Install::Base};
	8	$VERSION = '0.91';
	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}
12	12
13	13	my @boolean_keys = qw{
14	14	sign
15		mymeta
16	15	};
17	16
18	17	my @scalar_keys = qw{

439	438	/ixms ) {
440	439	my $license_text = $1;
441	440	my @phrases = (
442		'under the same (?:terms\|license) as perl itself' => 'perl', 1,
443		'GNU general public license' => 'gpl', 1,
444		'GNU public license' => 'gpl', 1,
445		'GNU lesser general public license' => 'lgpl', 1,
446		'GNU lesser public license' => 'lgpl', 1,
447		'GNU library general public license' => 'lgpl', 1,
448		'GNU library public license' => 'lgpl', 1,
449		'BSD license' => 'bsd', 1,
450		'Artistic license' => 'artistic', 1,
451		'GPL' => 'gpl', 1,
452		'LGPL' => 'lgpl', 1,
453		'BSD' => 'bsd', 1,
454		'Artistic' => 'artistic', 1,
455		'MIT' => 'mit', 1,
456		'proprietary' => 'proprietary', 0,
	441	'under the same (?:terms\|license) as (?:perl\|the perl programming language) itself' => 'perl', 1,
	442	'GNU general public license' => 'gpl', 1,
	443	'GNU public license' => 'gpl', 1,
	444	'GNU lesser general public license' => 'lgpl', 1,
	445	'GNU lesser public license' => 'lgpl', 1,
	446	'GNU library general public license' => 'lgpl', 1,
	447	'GNU library public license' => 'lgpl', 1,
	448	'BSD license' => 'bsd', 1,
	449	'Artistic license' => 'artistic', 1,
	450	'GPL' => 'gpl', 1,
	451	'LGPL' => 'lgpl', 1,
	452	'BSD' => 'bsd', 1,
	453	'Artistic' => 'artistic', 1,
	454	'MIT' => 'mit', 1,
	455	'proprietary' => 'proprietary', 0,
457	456	);
458	457	while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
459	458	$pattern =~ s{\s+}{\\s+}g;

505	504	}
506	505	}
507	506
	507	sub test_requires_from {
	508	my $self = shift;
	509	my $content = Module::Install::_readperl($_[0]);
	510	my @requires = $content =~ m/^use\s+([^\W\d]\w(?:::\w+))\s+([\d\.]+)/mg;
	511	while ( @requires ) {
	512	my $module = shift @requires;
	513	my $version = shift @requires;
	514	$self->test_requires( $module => $version );
	515	}
	516	}
	517
508	518	# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
509	519	# numbers (eg, 5.006001 or 5.008009).
510	520	# Also, convert double-part versions (eg, 5.8)
511	521	sub _perl_version {
512	522	my $v = $_[-1];
513		$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
	523	$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
514	524	$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0\|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 \|\| 0)/e;
515	525	$v =~ s/(\.\d\d\d)000$/$1/;
516	526	$v =~ s/_.+$//;
517	527	if ( ref($v) ) {
518		$v = $v + 0; # Numify
	528	# Numify
	529	$v = $v + 0;
519	530	}
520	531	return $v;
521	532	}

525	536
526	537
527	538	######################################################################
528		# MYMETA.yml Support
	539	# MYMETA Support
529	540
530	541	sub WriteMyMeta {
531	542	die "WriteMyMeta has been deprecated";
532	543	}
533	544
534		sub write_mymeta {
535		my $self = shift;
536
537		# If there's no existing META.yml there is nothing we can do
538		return unless -f 'META.yml';
	545	sub write_mymeta_yaml {
	546	my $self = shift;
539	547
540	548	# We need YAML::Tiny to write the MYMETA.yml file
541	549	unless ( eval { require YAML::Tiny; 1; } ) {
542	550	return 1;
	551	}
	552
	553	# Generate the data
	554	my $meta = $self->_write_mymeta_data or return 1;
	555
	556	# Save as the MYMETA.yml file
	557	print "Writing MYMETA.yml\n";
	558	YAML::Tiny::DumpFile('MYMETA.yml', $meta);
	559	}
	560
	561	sub write_mymeta_json {
	562	my $self = shift;
	563
	564	# We need JSON to write the MYMETA.json file
	565	unless ( eval { require JSON; 1; } ) {
	566	return 1;
	567	}
	568
	569	# Generate the data
	570	my $meta = $self->_write_mymeta_data or return 1;
	571
	572	# Save as the MYMETA.yml file
	573	print "Writing MYMETA.json\n";
	574	Module::Install::_write(
	575	'MYMETA.json',
	576	JSON->new->pretty(1)->canonical->encode($meta),
	577	);
	578	}
	579
	580	sub _write_mymeta_data {
	581	my $self = shift;
	582
	583	# If there's no existing META.yml there is nothing we can do
	584	return undef unless -f 'META.yml';
	585
	586	# We need Parse::CPAN::Meta to load the file
	587	unless ( eval { require Parse::CPAN::Meta; 1; } ) {
	588	return undef;
543	589	}
544	590
545	591	# Merge the perl version into the dependencies

557	603	}
558	604
559	605	# Load the advisory META.yml file
560		my @yaml = YAML::Tiny::LoadFile('META.yml');
	606	my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
561	607	my $meta = $yaml[0];
562	608
563	609	# Overwrite the non-configure dependency hashs

571	617	$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
572	618	}
573	619
574		# Save as the MYMETA.yml file
575		print "Writing MYMETA.yml\n";
576		YAML::Tiny::DumpFile('MYMETA.yml', $meta);
	620	return $meta;
577	621	}
578	622
579	623	1;

+3

-3

inc/Module/Install/Win32.pm less more

1	1	package Module::Install::Win32;
2	2
3	3	use strict;
4		use Module::Install::Base;
	4	use Module::Install::Base ();
5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '0.81';
9		@ISA = qw{Module::Install::Base};
	8	$VERSION = '0.91';
	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}
12	12

+14

-4

inc/Module/Install/WriteAll.pm less more

1	1	package Module::Install::WriteAll;
2	2
3	3	use strict;
4		use Module::Install::Base;
	4	use Module::Install::Base ();
5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '0.81';
	8	$VERSION = '0.91';;
9	9	@ISA = qw{Module::Install::Base};
10	10	$ISCORE = 1;
11	11	}

40	40
41	41	# The Makefile write process adds a couple of dependencies,
42	42	# so write the META.yml files after the Makefile.
43		$self->Meta->write if $args{meta};
44		$self->Meta->write_mymeta if $self->mymeta;
	43	if ( $args{meta} ) {
	44	$self->Meta->write;
	45	}
	46
	47	# Experimental support for MYMETA
	48	if ( $ENV{X_MYMETA} ) {
	49	if ( $ENV{X_MYMETA} eq 'JSON' ) {
	50	$self->Meta->write_mymeta_json;
	51	} else {
	52	$self->Meta->write_mymeta_yaml;
	53	}
	54	}
45	55
46	56	return 1;
47	57	}

+26

-14

inc/Module/Install.pm less more

16	16	# 3. The ./inc/ version of Module::Install loads
17	17	# }
18	18
19		BEGIN {
20		require 5.004;
21		}
	19	use 5.005;
22	20	use strict 'vars';
23	21
24		use vars qw{$VERSION};
	22	use vars qw{$VERSION $MAIN};
25	23	BEGIN {
26	24	# All Module::Install core packages now require synchronised versions.
27	25	# This will be used to ensure we don't accidentally load old or

29	27	# This is not enforced yet, but will be some time in the next few
30	28	# releases once we can make sure it won't clash with custom
31	29	# Module::Install extensions.
32		$VERSION = '0.81';
	30	$VERSION = '0.91';
	31
	32	# Storage for the pseudo-singleton
	33	$MAIN = undef;
33	34
34	35	inc::Module::Install::VERSION = VERSION;
35	36	@inc::Module::Install::ISA = __PACKAGE__;

92	93
93	94
94	95
	96
95	97	# Build.PL was formerly supported, but no longer is due to excessive
96	98	# difficulty in implementing every single feature twice.
97	99	if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }

130	132	$sym->{$cwd} = sub {
131	133	my $pwd = Cwd::cwd();
132	134	if ( my $code = $sym->{$pwd} ) {
133		# delegate back to parent dirs
	135	# Delegate back to parent dirs
134	136	goto &$code unless $cwd eq $pwd;
135	137	}
136	138	$$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
137		unless ( uc($1) eq $1 ) {
138		unshift @_, ( $self, $1 );
139		goto &{$self->can('call')};
	139	my $method = $1;
	140	if ( uc($method) eq $method ) {
	141	# Do nothing
	142	return;
	143	} elsif ( $method =~ /^_/ and $self->can($method) ) {
	144	# Dispatch to the root M:I class
	145	return $self->$method(@_);
140	146	}
	147
	148	# Dispatch to the appropriate plugin
	149	unshift @_, ( $self, $1 );
	150	goto &{$self->can('call')};
141	151	};
142	152	}
143	153

162	172	delete $INC{"$self->{file}"};
163	173	delete $INC{"$self->{path}.pm"};
164	174
	175	# Save to the singleton
	176	$MAIN = $self;
	177
165	178	return 1;
166	179	}
167	180

175	188
176	189	my @exts = @{$self->{extensions}};
177	190	unless ( @exts ) {
178		my $admin = $self->{admin};
179		@exts = $admin->load_all_extensions;
	191	@exts = $self->{admin}->load_all_extensions;
180	192	}
181	193
182	194	my %seen;

259	271	sub load_extensions {
260	272	my ($self, $path, $top) = @_;
261	273
262		unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
	274	unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
263	275	unshift @INC, $self->{prefix};
264	276	}
265	277

340	352	if ( $] >= 5.006 ) {
341	353	open( FH, '<', $_[0] ) or die "open($_[0]): $!";
342	354	} else {
343		open( FH, "< $_[0]" ) or die "open($_[0]): $!";
	355	open( FH, "< $_[0]" ) or die "open($_[0]): $!";
344	356	}
345	357	my $string = do { local $/; <FH> };
346	358	close FH or die "close($_[0]): $!";

371	383	if ( $] >= 5.006 ) {
372	384	open( FH, '>', $_[0] ) or die "open($_[0]): $!";
373	385	} else {
374		open( FH, "> $_[0]" ) or die "open($_[0]): $!";
	386	open( FH, "> $_[0]" ) or die "open($_[0]): $!";
375	387	}
376	388	foreach ( 1 .. $#_ ) {
377	389	print FH $_[$_] or die "print($_[0]): $!";

+3

-1

lib/Class/C3/XS.pm less more

3	3	use strict;
4	4	use warnings;
5	5
6		our $VERSION = '0.11';
	6	our $VERSION = '0.13';
7	7
8	8	=pod
9	9

46	46	require XSLoader;
47	47	XSLoader::load('Class::C3::XS', $VERSION);
48	48
	49	$VERSION = eval $VERSION;
	50
49	51	package # hide me from PAUSE
50	52	next;
51	53