Commit 3f17e2e4d3c818a063f19e1710799f7a68457f27 - libhtml-html5-entities-perl

Imported Upstream version 0.004 Angel Abad 9 years ago

40 changed file(s) with 593 addition(s) and 5069 deletion(s). Raw diff Collapse all Expand all

+83

-0

CONTRIBUTING less more

	0	NAME
	1	CONTRIBUTING
	2
	3	DESCRIPTION
	4	If you're reading this document, that means you might be thinking about
	5	helping me out with this project. Thanks!
	6
	7	Here's some ways you could help out:
	8
	9	* Bug reports
	10
	11	Found a bug? Great! (Well, not so great I suppose.)
	12
	13	The place to report them is <https://rt.cpan.org/>. Don't e-mail me
	14	about it, as your e-mail is more than likely to get lost amongst the
	15	spam.
	16
	17	An example script clearly demonstrating the bug (preferably written
	18	using Test::More) would be greatly appreciated.
	19
	20	* Patches
	21
	22	If you've found a bug and written a fix for it, even better!
	23
	24	Generally speaking you should check out the latest copy of the code
	25	from the source repository rather than using the CPAN distribution.
	26	The file META.yml should contain a link to the source repository. If
	27	not, then try <https://github.com/tobyink> or submit a bug report.
	28	(As far as I'm concerned the lack of a link is a bug.) Many of my
	29	distributions are also mirrored at <https://bitbucket.org/tobyink>.
	30
	31	To submit the patch, do a pull request on GitHub or Bitbucket, or
	32	attach a diff file to a bug report. Unless otherwise stated, I'll
	33	assume that your contributions are licensed under the same terms as
	34	the rest of the project.
	35
	36	(If using git, feel free to work in a branch. For Mercurial, I'd
	37	prefer bookmarks within the default branch.)
	38
	39	* Documentation
	40
	41	If there's anything unclear in the documentation, please submit this
	42	as a bug report or patch as above.
	43
	44	Non-toy example scripts that I can bundle would also be appreciated.
	45
	46	* Translation
	47
	48	Translations of documentation would be welcome.
	49
	50	For translations of error messages and other strings embedded in the
	51	code, check with me first. Sometimes the English strings may not in
	52	a stable state, so it would be a waste of time translating them.
	53
	54	Coding Style
	55	I tend to write using something approximating the Allman style, using
	56	tabs for indentation and Unix-style line breaks.
	57
	58	* <http://en.wikipedia.org/wiki/Indent_style#Allman_style>
	59
	60	* <http://www.derkarl.org/why_to_tabs.html>
	61
	62	I nominally encode all source files as UTF-8, though in practice most of
	63	them use a 7-bit-safe ASCII-compatible subset of UTF-8.
	64
	65	AUTHOR
	66	Toby Inkster <tobyink@cpan.org>.
	67
	68	COPYRIGHT AND LICENCE
	69	Copyright (c) 2012-2014 by Toby Inkster.
	70
	71	CONTRIBUTING is available under three different licences permitting its
	72	redistribution: the CC-BY-SA_UK-2.0 licence, plus the same licences as
	73	Perl itself, which is distributed under the GNU General Public Licence
	74	version 1, and the Artistic Licence.
	75
	76	This file is licensed under the Creative Commons Attribution-ShareAlike
	77	2.0 UK: England & Wales License. To view a copy of this license, visit
	78	<http://creativecommons.org/licenses/by-sa/2.0/uk/>.
	79
	80	This file is free software; you can redistribute it and/or modify it
	81	under the same terms as the Perl 5 programming language system itself.
	82

+58

-0

	0	Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
	1	Upstream-Name: HTML-HTML5-Entities
	2	Upstream-Contact: TOBYINK <tobyink@cpan.org> and Toby Inkster <tobyink@cpan.org>
	3	Source: https://metacpan.org/release/HTML-HTML5-Entities
	4
	5	Files: Changes
	6	META.json
	7	META.yml
	8	dist.ini
	9	doap.ttl
	10	t/03decoding.t
	11	t/04roundtrip.t
	12	Copyright: Copyright 2014 Toby Inkster.
	13	License: GPL-1.0+ or Artistic-1.0
	14
	15	Files: CONTRIBUTING
	16	INSTALL
	17	LICENSE
	18	Copyright: Unknown
	19	License: Unknown
	20
	21	Files: COPYRIGHT
	22	CREDITS
	23	SIGNATURE
	24	Copyright: None
	25	License: public-domain
	26
	27	Files: README
	28	lib/HTML/HTML5/Entities.pm
	29	Copyright: Copyright (c) 1995-2006 by Gisle Aas.
	30	Copyright (c) 2012 by Toby Inkster.
	31	Copyright (c) 2004-2007 by Apple Computer Inc, Mozilla Foundation,.
	32	Copyright (c) 2007-2011 by Wakaba <w@suika.fam.cx>.
	33	Copyright (c) 2009-2012 by Toby Inkster <tobyink@cpan.org>.
	34	License: GPL-1.0+ or Artistic-1.0
	35
	36	Files: t/01basic.t
	37	t/02encoding.t
	38	Copyright: Copyright 2011 Toby Inkster.
	39	License: GPL-1.0+ or Artistic-1.0
	40
	41	Files: Makefile.PL
	42	Copyright: Copyright 2013 Toby Inkster.
	43	License: GPL-1.0+ or Artistic-1.0
	44
	45	License: Artistic-1.0
	46	This software is Copyright (c) 2014 by the copyright holder(s).
	47
	48	This is free software, licensed under:
	49
	50	The Artistic License 1.0
	51
	52	License: GPL-1.0
	53	This software is Copyright (c) 2014 by the copyright holder(s).
	54
	55	This is free software, licensed under:
	56
	57	The GNU General Public License, Version 1, February 1989

-0

CREDITS less more

	0	Maintainer:
	1	- TOBYINK <tobyink@cpan.org>
	2	- Toby Inkster <tobyink@cpan.org>
	3
	4	Thanks:
	5	- <pagenyon@gmail.com>
	6

+15

-5

Changes less more

3	3	Created: 2011-10-06
4	4	Home page: <https://metacpan.org/release/HTML-HTML5-Entities>
5	5	Bug tracker: <http://rt.cpan.org/Dist/Display.html?Queue=HTML-HTML5-Entities>
	6	Maintainer: Toby Inkster <tobyink@cpan.org>
6	7
7		0.003 2012-06-26
	8	0.004 2014-09-13
	9
	10	[ Bug Fixes ]
	11	- Various RT#97659-related fixes.
	12	Fixes RT#97659.
	13	mailto:pagenyon@gmail.com++
	14	<https://rt.cpan.org/Ticket/Display.html?id=97659>
	15
	16	[ Packaging ]
	17	- Switch to Dist::Inkt.
	18
	19	0.003 2012-06-26
8	20
9	21	- Drop non-core dependencies.
10	22
11		0.002 2012-01-16
	23	0.002 2012-01-16
12	24
13	25	- %char2entity is now a more conservative mapping, based on XHTML 1.0 (but
14	26	without apos). This makes it safer for serialising XHTML 1.x, HTML4 and
15	27	HTML5 documents.
16	28
17		0.001 2011-10-07 # Initial release
18
19
	29	0.001 2011-10-07 Initial release

+38

-0

INSTALL less more

	0	Installing HTML-HTML5-Entities should be straightforward.
	1
	2	INSTALLATION WITH CPANMINUS
	3	If you have cpanm, you only need one line:
	4
	5	% cpanm HTML::HTML5::Entities
	6
	7	If you are installing into a system-wide directory, you may need to pass
	8	the "-S" flag to cpanm, which uses sudo to install the module:
	9
	10	% cpanm -S HTML::HTML5::Entities
	11
	12	INSTALLATION WITH THE CPAN SHELL
	13	Alternatively, if your CPAN shell is set up, you should just be able to
	14	do:
	15
	16	% cpan HTML::HTML5::Entities
	17
	18	MANUAL INSTALLATION
	19	As a last resort, you can manually install it. Download the tarball and
	20	unpack it.
	21
	22	Consult the file META.json for a list of pre-requisites. Install these
	23	first.
	24
	25	To build HTML-HTML5-Entities:
	26
	27	% perl Makefile.PL
	28	% make && make test
	29
	30	Then install it:
	31
	32	% make install
	33
	34	If you are installing into a system-wide directory, you may need to run:
	35
	36	% sudo make install
	37

-4

LICENSE less more

0		This software is copyright (c) 2012 by Toby Inkster <tobyink@cpan.org>.
	0	This software is copyright (c) 2014 by Toby Inkster.
1	1
2	2	This is free software; you can redistribute it and/or modify it under
3	3	the same terms as the Perl 5 programming language system itself.

11	11
12	12	--- The GNU General Public License, Version 1, February 1989 ---
13	13
14		This software is Copyright (c) 2012 by Toby Inkster <tobyink@cpan.org>.
	14	This software is Copyright (c) 2014 by Toby Inkster.
15	15
16	16	This is free software, licensed under:
17	17

21	21	Version 1, February 1989
22	22
23	23	Copyright (C) 1989 Free Software Foundation, Inc.
24		51 Franklin St, Suite 500, Boston, MA 02110-1335 USA
	24	51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
25	25
26	26	Everyone is permitted to copy and distribute verbatim copies
27	27	of this license document, but changing it is not allowed.

271	271
272	272	--- The Artistic License 1.0 ---
273	273
274		This software is Copyright (c) 2012 by Toby Inkster <tobyink@cpan.org>.
	274	This software is Copyright (c) 2014 by Toby Inkster.
275	275
276	276	This is free software, licensed under:
277	277

+14

-29

MANIFEST less more

	0	CONTRIBUTING
	1	COPYRIGHT
	2	CREDITS
0	3	Changes
1		inc/Module/AutoInstall.pm
2		inc/Module/Install.pm
3		inc/Module/Install/AutoInstall.pm
4		inc/Module/Install/AutoManifest.pm
5		inc/Module/Install/Base.pm
6		inc/Module/Install/Can.pm
7		inc/Module/Install/Fetch.pm
8		inc/Module/Install/Include.pm
9		inc/Module/Install/Makefile.pm
10		inc/Module/Install/Metadata.pm
11		inc/Module/Install/Package.pm
12		inc/Module/Install/TrustMetaYml.pm
13		inc/Module/Install/Win32.pm
14		inc/Module/Install/WriteAll.pm
15		inc/Module/Package.pm
16		inc/Module/Package/Dist/RDF.pm
17		inc/Scalar/Util.pm
18		inc/Scalar/Util/PP.pm
19		inc/unicore/Name.pm
20		inc/YAML/Tiny.pm
	4	INSTALL
	5	LICENSE
	6	MANIFEST
	7	META.json
	8	META.yml
	9	Makefile.PL
	10	README
	11	SIGNATURE
	12	dist.ini
	13	doap.ttl
21	14	lib/HTML/HTML5/Entities.pm
22		LICENSE
23		Makefile.PL
24		MANIFEST This list of files
25		META.yml
26		meta/changes.ttl
27		meta/doap.ttl
28		meta/makefile.ttl
29		README
30	15	t/01basic.t
31	16	t/02encoding.t
32	17	t/03decoding.t
33		SIGNATURE Public-key signature (added by MakeMaker)
	18	t/04roundtrip.t

+63

-0

META.json less more

	0	{
	1	"abstract" : "drop-in replacement for HTML::Entities",
	2	"author" : [
	3	"Toby Inkster <tobyink@cpan.org>",
	4	"TOBYINK <tobyink@cpan.org>"
	5	],
	6	"dynamic_config" : 0,
	7	"generated_by" : "Dist::Inkt::Profile::TOBYINK version 0.016, CPAN::Meta::Converter version 2.140640",
	8	"keywords" : [],
	9	"license" : [
	10	"perl_5"
	11	],
	12	"meta-spec" : {
	13	"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
	14	"version" : "2"
	15	},
	16	"name" : "HTML-HTML5-Entities",
	17	"no_index" : {
	18	"directory" : [
	19	"eg",
	20	"examples",
	21	"inc",
	22	"t",
	23	"xt"
	24	]
	25	},
	26	"optional_features" : {},
	27	"prereqs" : {
	28	"configure" : {
	29	"requires" : {
	30	"ExtUtils::MakeMaker" : "6.17"
	31	}
	32	},
	33	"test" : {
	34	"requires" : {
	35	"Test::More" : "0.61"
	36	}
	37	}
	38	},
	39	"provides" : {
	40	"HTML::HTML5::Entities" : {
	41	"file" : "lib/HTML/HTML5/Entities.pm",
	42	"version" : "0.004"
	43	}
	44	},
	45	"release_status" : "stable",
	46	"resources" : {
	47	"X_identifier" : "http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/project",
	48	"bugtracker" : {
	49	"web" : "http://rt.cpan.org/Dist/Display.html?Queue=HTML-HTML5-Entities"
	50	},
	51	"homepage" : "https://metacpan.org/release/HTML-HTML5-Entities",
	52	"license" : [
	53	"http://dev.perl.org/licenses/"
	54	],
	55	"repository" : {
	56	"type" : "git",
	57	"url" : "git://github.com/tobyink/p5-html-html5-entities.git",
	58	"web" : "https://github.com/tobyink/p5-html-html5-entities"
	59	}
	60	},
	61	"version" : "0.004"
	62	}

+16

-11

META.yml less more

1	1	abstract: 'drop-in replacement for HTML::Entities'
2	2	author:
3	3	- 'Toby Inkster <tobyink@cpan.org>'
	4	- 'TOBYINK <tobyink@cpan.org>'
4	5	build_requires:
5		ExtUtils::MakeMaker: 6.59
6		Test::More: 0.61
	6	Test::More: '0.61'
7	7	configure_requires:
8		ExtUtils::MakeMaker: 6.59
9		distribution_type: module
10		dynamic_config: 1
11		generated_by: 'Module::Install version 1.06'
	8	ExtUtils::MakeMaker: '6.17'
	9	dynamic_config: 0
	10	generated_by: 'Dist::Inkt::Profile::TOBYINK version 0.016, CPAN::Meta::Converter version 2.140640'
12	11	keywords: []
13	12	license: perl
14	13	meta-spec:
15	14	url: http://module-build.sourceforge.net/META-spec-v1.4.html
16		version: 1.4
17		module_name: HTML::HTML5::Entities
	15	version: '1.4'
18	16	name: HTML-HTML5-Entities
19	17	no_index:
20	18	directory:
	19	- eg
	20	- examples
21	21	- inc
22	22	- t
23	23	- xt
24		requires:
25		perl: 5.8.1
	24	optional_features: {}
	25	provides:
	26	HTML::HTML5::Entities:
	27	file: lib/HTML/HTML5/Entities.pm
	28	version: '0.004'
26	29	resources:
	30	X_identifier: http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/project
27	31	bugtracker: http://rt.cpan.org/Dist/Display.html?Queue=HTML-HTML5-Entities
28	32	homepage: https://metacpan.org/release/HTML-HTML5-Entities
29	33	license: http://dev.perl.org/licenses/
30		version: 0.003
	34	repository: git://github.com/tobyink/p5-html-html5-entities.git
	35	version: '0.004'

+140

-1

Makefile.PL less more

0		use inc::Module::Package 'RDF:standard';
	0	use strict;
	1	use ExtUtils::MakeMaker 6.17;
1	2
	3	my $EUMM = eval( $ExtUtils::MakeMaker::VERSION );
	4
	5	my $meta = {
	6	"abstract" => "drop-in replacement for HTML::Entities",
	7	"author" => [
	8	"Toby Inkster <tobyink\@cpan.org>",
	9	"TOBYINK <tobyink\@cpan.org>",
	10	],
	11	"dynamic_config" => 0,
	12	"generated_by" => "Dist::Inkt::Profile::TOBYINK version 0.016, CPAN::Meta::Converter version 2.140640",
	13	"keywords" => [],
	14	"license" => ["perl_5"],
	15	"meta-spec" => {
	16	url => "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
	17	version => 2,
	18	},
	19	"name" => "HTML-HTML5-Entities",
	20	"no_index" => { directory => ["eg", "examples", "inc", "t", "xt"] },
	21	"prereqs" => {
	22	configure => { requires => { "ExtUtils::MakeMaker" => 6.17 } },
	23	test => { requires => { "Test::More" => 0.61 } },
	24	},
	25	"provides" => {
	26	"HTML::HTML5::Entities" => { file => "lib/HTML/HTML5/Entities.pm", version => 0.004 },
	27	},
	28	"release_status" => "stable",
	29	"resources" => {
	30	bugtracker => {
	31	web => "http://rt.cpan.org/Dist/Display.html?Queue=HTML-HTML5-Entities",
	32	},
	33	homepage => "https://metacpan.org/release/HTML-HTML5-Entities",
	34	license => ["http://dev.perl.org/licenses/"],
	35	repository => {
	36	type => "git",
	37	url => "git://github.com/tobyink/p5-html-html5-entities.git",
	38	web => "https://github.com/tobyink/p5-html-html5-entities",
	39	},
	40	X_identifier => "http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/project",
	41	},
	42	"version" => 0.004,
	43	};
	44
	45	my %dynamic_config;
	46
	47	my %WriteMakefileArgs = (
	48	ABSTRACT => $meta->{abstract},
	49	AUTHOR => ($EUMM >= 6.5702 ? $meta->{author} : $meta->{author}[0]),
	50	DISTNAME => $meta->{name},
	51	VERSION => $meta->{version},
	52	EXE_FILES => [ map $_->{file}, values %{ $meta->{x_provides_scripts} \|\| {} } ],
	53	NAME => do { my $n = $meta->{name}; $n =~ s/-/::/g; $n },
	54	test => { TESTS => "t/*.t" },
	55	%dynamic_config,
	56	);
	57
	58	$WriteMakefileArgs{LICENSE} = $meta->{license}[0] if $EUMM >= 6.3001;
	59
	60	sub deps
	61	{
	62	my %r;
	63	for my $stage (@_)
	64	{
	65	for my $dep (keys %{$meta->{prereqs}{$stage}{requires}})
	66	{
	67	next if $dep eq 'perl';
	68	my $ver = $meta->{prereqs}{$stage}{requires}{$dep};
	69	$r{$dep} = $ver if !exists($r{$dep}) \|\| $ver >= $r{$dep};
	70	}
	71	}
	72	\%r;
	73	}
	74
	75	my ($build_requires, $configure_requires, $runtime_requires, $test_requires);
	76	if ($EUMM >= 6.6303)
	77	{
	78	$WriteMakefileArgs{BUILD_REQUIRES} \|\|= deps('build');
	79	$WriteMakefileArgs{CONFIGURE_REQUIRES} \|\|= deps('configure');
	80	$WriteMakefileArgs{TEST_REQUIRES} \|\|= deps('test');
	81	$WriteMakefileArgs{PREREQ_PM} \|\|= deps('runtime');
	82	}
	83	elsif ($EUMM >= 6.5503)
	84	{
	85	$WriteMakefileArgs{BUILD_REQUIRES} \|\|= deps('build', 'test');
	86	$WriteMakefileArgs{CONFIGURE_REQUIRES} \|\|= deps('configure');
	87	$WriteMakefileArgs{PREREQ_PM} \|\|= deps('runtime');
	88	}
	89	elsif ($EUMM >= 6.52)
	90	{
	91	$WriteMakefileArgs{CONFIGURE_REQUIRES} \|\|= deps('configure');
	92	$WriteMakefileArgs{PREREQ_PM} \|\|= deps('runtime', 'build', 'test');
	93	}
	94	else
	95	{
	96	$WriteMakefileArgs{PREREQ_PM} \|\|= deps('configure', 'build', 'test', 'runtime');
	97	}
	98
	99	{
	100	my ($minperl) = reverse sort(
	101	grep defined && /^[0-9]+(\.[0-9]+)?$/,
	102	map $meta->{prereqs}{$_}{requires}{perl},
	103	qw( configure build runtime )
	104	);
	105
	106	if (defined($minperl))
	107	{
	108	die "Installing $meta->{name} requires Perl >= $minperl"
	109	unless $] >= $minperl;
	110
	111	$WriteMakefileArgs{MIN_PERL_VERSION} \|\|= $minperl
	112	if $EUMM >= 6.48;
	113	}
	114	}
	115
	116	sub FixMakefile
	117	{
	118	return unless -d 'inc';
	119	my $file = shift;
	120
	121	local *MAKEFILE;
	122	open MAKEFILE, "< $file" or die "FixMakefile: Couldn't open $file: $!; bailing out";
	123	my $makefile = do { local $/; <MAKEFILE> };
	124	close MAKEFILE or die $!;
	125
	126	$makefile =~ s/\b(test_harness$\$\(TEST_VERBOSE$, )/$1'inc', /;
	127	$makefile =~ s/( -I\$$INST_ARCHLIB$)/ -Iinc$1/g;
	128	$makefile =~ s/( "-I\$$INST_LIB$")/ "-Iinc"$1/g;
	129	$makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
	130	$makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
	131
	132	open MAKEFILE, "> $file" or die "FixMakefile: Couldn't open $file: $!; bailing out";
	133	print MAKEFILE $makefile or die $!;
	134	close MAKEFILE or die $!;
	135	}
	136
	137	my $mm = WriteMakefile(%WriteMakefileArgs);
	138	FixMakefile($mm->{FIRST_MAKEFILE} \|\| 'Makefile');
	139	exit(0);
	140

+24

-25

README less more

10	10	print "$dec\n"; # fish & chips
11	11
12	12	DESCRIPTION
13		This is a drop-in replacement for HTML::Entities, providing the
14		character entities defined in HTML5. Some caveats:
	13	This is a drop-in replacement for HTML::Entities, providing the character
	14	entities defined in HTML5. Some caveats:
15	15
16	16	* The implementation is pure perl, hence in some cases slower,
17	17	especially decoding.

19	19	* It will not work in Perl < 5.8.1.
20	20
21	21	Functions
22		"decode_entities($string, ...)"
	22	`decode_entities($string, ...)`
23	23	This routine replaces HTML entities found in the $string with the
24	24	corresponding Unicode character. If multiple strings are provided as
25	25	arguments they are each decoded separately and the same number of

29	29
30	30	This routine is exported by default.
31	31
32		"_decode_entities($string, \%entity2char)"
33		"_decode_entities($string, \%entity2char, $expand_prefix)"
34		This will in-place replace HTML entities in $string. The
35		%entity2char hash must be provided. Named entities not found in the
36		%entity2char hash are left alone. Numeric entities are always
37		expanded.
	32	`_decode_entities($string, \%entity2char)`
	33	`_decode_entities($string, \%entity2char, $expand_prefix)`
	34	This will in-place replace HTML entities in $string. The %entity2char
	35	hash must be provided. Named entities not found in the %entity2char
	36	hash are left alone. Numeric entities are always expanded.
38	37
39	38	If $expand_prefix is TRUE then entities without trailing ";" in
40	39	%entity2char will even be expanded as a prefix of a longer

46	45
47	46	This routine is exported by default.
48	47
49		"encode_entities($string)"
50		"encode_entities($string, $unsafe_chars)"
	48	`encode_entities($string)`
	49	`encode_entities($string, $unsafe_chars)`
51	50	This routine replaces unsafe characters in $string with their entity
52	51	representation. A second argument can be given to specify which
53	52	characters to consider unsafe (i.e., which to escape). This may be a

57	56
58	57	This routine is exported by default.
59	58
60		"encode_entities_numeric($string)"
	59	`encode_entities_numeric($string)`
61	60	This routine works just like encode_entities, except that the
62	61	replacement entities are always numeric.
63	62
64	63	This routine is not exported by default.
65	64
66		"num_entity($string)"
	65	`num_entity($string)`
67	66	Given a single character string, encodes it as a numeric entity.
68	67
69	68	This routine is not exported by default.

71	70	The following functions cannot be exported. They behave the same as the
72	71	exportable functions.
73	72
74		"HTML::Entities::decode($string, ...)"
75		"HTML::Entities::encode($string)"
76		"HTML::Entities::encode($string, $unsafe_characters)"
77		"HTML::Entities::encode_numeric($string)"
78		"HTML::Entities::encode_numeric($string, $unsafe_characters)"
79		"HTML::Entities::encode_numerically($string)"
80		"HTML::Entities::encode_numerically($string, $unsafe_characters)"
	73	`HTML::Entities::decode($string, ...)`
	74	`HTML::Entities::encode($string)`
	75	`HTML::Entities::encode($string, $unsafe_characters)`
	76	`HTML::Entities::encode_numeric($string)`
	77	`HTML::Entities::encode_numeric($string, $unsafe_characters)`
	78	`HTML::Entities::encode_numerically($string)`
	79	`HTML::Entities::encode_numerically($string, $unsafe_characters)`
81	80
82	81	Variables
83	82	$HTML::HTML5::Entities::hex

95	94	exported.
96	95
97	96	Note that %char2entity is a more conservative set of mappings,
98		intended to be safe for serialising strings to HTML4, HTML5 and
99		XHTML 1.x. And for hysterical raisins, %entity2char does not include
100		the leading ampersands, while %char2entity does.
	97	intended to be safe for serialising strings to HTML4, HTML5 and XHTML
	98	1.x. And for hysterical raisins, %entity2char does not include the
	99	leading ampersands, while %char2entity does.
101	100
102	101	BUGS
103	102	Please report any bugs to

115	114
116	115	Copyright (c) 2012 by Toby Inkster.
117	116
118		This is free software; you can redistribute it and/or modify it under
119		the same terms as the Perl 5 programming language system itself.
	117	This is free software; you can redistribute it and/or modify it under the
	118	same terms as the Perl 5 programming language system itself.
120	119
121	120	Entity Tables
122	121	Copyright (c) 2004-2007 by Apple Computer Inc, Mozilla Foundation, and

+21

-36

SIGNATURE less more

0	0	This file contains message digests of all files listed in MANIFEST,
1		signed via the Module::Signature module, version 0.68.
	1	signed via the Module::Signature module, version 0.73.
2	2
3	3	To verify the content in this distribution, first make sure you have
4	4	Module::Signature installed, then type:

13	13	-----BEGIN PGP SIGNED MESSAGE-----
14	14	Hash: SHA1
15	15
16		SHA1 3543ece06ee75dc520b7ca287b9b4093afd0203b Changes
17		SHA1 cc087c3dd6e1b519c680e68cd0231735a68300a0 LICENSE
18		SHA1 6352c202f66e82b3e7f251f9b7e48b5295d99bb2 MANIFEST
19		SHA1 30a1c865333391cb76a3e0a150978e6fda226315 META.yml
20		SHA1 7150e5e086ef493e1e527a1eeec44a8344b80db6 Makefile.PL
21		SHA1 e8c8e03df113f6fecfcdb9f8b67d50540439899b README
22		SHA1 06c410f05488c1612ed66b06d3a86b2580581e4a inc/Module/AutoInstall.pm
23		SHA1 8a924add836b60fb23b25c8506d45945e02f42f4 inc/Module/Install.pm
24		SHA1 61ab1dd37e33ddbe155907ce51df8a3e56ac8bbf inc/Module/Install/AutoInstall.pm
25		SHA1 c04f94f91fa97b9f8cfb5a36071098ab0e6c78e3 inc/Module/Install/AutoManifest.pm
26		SHA1 2d0fad3bf255f8c1e7e1e34eafccc4f595603ddc inc/Module/Install/Base.pm
27		SHA1 f0e01fff7d73cd145fbf22331579918d4628ddb0 inc/Module/Install/Can.pm
28		SHA1 7328966e4fda0c8451a6d3850704da0b84ac1540 inc/Module/Install/Fetch.pm
29		SHA1 66d3d335a03492583a3be121a7d888f63f08412c inc/Module/Install/Include.pm
30		SHA1 b62ca5e2d58fa66766ccf4d64574f9e1a2250b34 inc/Module/Install/Makefile.pm
31		SHA1 1aa925be410bb3bfcd84a16985921f66073cc1d2 inc/Module/Install/Metadata.pm
32		SHA1 3b9281ddf7dd6d6f5de0a9642c69333023193c80 inc/Module/Install/Package.pm
33		SHA1 b86d0385e10881db680d28bde94f275e49e34a27 inc/Module/Install/TrustMetaYml.pm
34		SHA1 e4196994fa75e98bdfa2be0bdeeffef66de88171 inc/Module/Install/Win32.pm
35		SHA1 c3a6d0d5b84feb3280622e9599e86247d58b0d18 inc/Module/Install/WriteAll.pm
36		SHA1 26d58a041cd6b3d21db98b32e8fd1841aae21204 inc/Module/Package.pm
37		SHA1 6b807287940754cc31a3db59f2b22e363d5525be inc/Module/Package/Dist/RDF.pm
38		SHA1 e31c281782183601e1e057c5914f63269e043932 inc/Scalar/Util.pm
39		SHA1 5eae2f71c45a996a296d2445b18d0589307111f0 inc/Scalar/Util/PP.pm
40		SHA1 feb933cefe2e3762e8322bd6071a2499f3440da1 inc/YAML/Tiny.pm
41		SHA1 8105c0510a773b56840995fb4dd2dc64fe9ddaee inc/unicore/Name.pm
42		SHA1 12216f579e4886f7dccacd80523f8faa455c14a3 lib/HTML/HTML5/Entities.pm
43		SHA1 c4362c46e72abf52f9686d07a10f62aa37961834 meta/changes.ttl
44		SHA1 89bbef5e74f4d9ff30efa245002324ee7aea2951 meta/doap.ttl
45		SHA1 b2d1d5082a56c7b674f3e4402ee37cc5e913c689 meta/makefile.ttl
	16	SHA1 33317486c4fa2cf7fec85bf92ed38ac0f64233a0 CONTRIBUTING
	17	SHA1 fe8305f6e0407ec483da7f3dc3579e9877d207ba COPYRIGHT
	18	SHA1 71f63be2007853664b0a85353d5a1f21022c0598 CREDITS
	19	SHA1 ab7d3d9c5f5e1156c15f000b9a3fc5655c83e42c Changes
	20	SHA1 c81cf76f7d892d08771a14ae7bed1f8c7e218a27 INSTALL
	21	SHA1 34f5e12514b91055de4b164a1f2327ef5c30ba53 LICENSE
	22	SHA1 d9610268f904d485658ebf23e50968edb4428062 MANIFEST
	23	SHA1 a5732c9a132222980dd24701bff5b70744eac629 META.json
	24	SHA1 4417352b04fb87120135cc7cbc68b1101ff1352f META.yml
	25	SHA1 1a9c23f060957fdfe545ee7e372018552d851d12 Makefile.PL
	26	SHA1 ae7845a6eb801bd66338fa2052cce2d6380c26b1 README
	27	SHA1 17440f64aa36e422f5aef7e876d217d3c8758949 dist.ini
	28	SHA1 ac296f342a8d8570aaabdc1f54892f5e7b77f630 doap.ttl
	29	SHA1 586b1dc8628ac0e951d581362d56710aa8e54f0b lib/HTML/HTML5/Entities.pm
46	30	SHA1 e216f83157b154e1578a38666323552d64e8fc1e t/01basic.t
47	31	SHA1 270072a86a73156f5f0d4bb493d572600b266cef t/02encoding.t
48		SHA1 3ebdef36ca3d57053c9e159b6a09eb6c057264ea t/03decoding.t
	32	SHA1 0ab915a6d87ef0e0adf0938bc94e2a4885e86049 t/03decoding.t
	33	SHA1 823071198d2a7477d6e2a8a1dbe0371b21271f2e t/04roundtrip.t
49	34	-----BEGIN PGP SIGNATURE-----
50		Version: GnuPG v1.4.10 (GNU/Linux)
	35	Version: GnuPG v1
51	36
52		iEYEARECAAYFAk/qHjYACgkQzr+BKGoqfTm8vwCgne+N01KkZjLloZINeaVMtajI
53		hiIAoLbC4H2DIYluc5JVUKc/qYOBIWUK
54		=FZFr
	37	iEYEARECAAYFAlQUWnUACgkQzr+BKGoqfTlTHACfeD8uZzDzsCvV+m3v1RkXMaei
	38	HtcAniJ4xGtvoITIpDP4Z6sUe9y160oz
	39	=tkxr
55	40	-----END PGP SIGNATURE-----

-0

dist.ini less more

	0	;;class='Dist::Inkt::Profile::TOBYINK'
	1	;;name='HTML-HTML5-Entities'

+91

-0

doap.ttl less more

	0	@prefix dc: <http://purl.org/dc/terms/> .
	1	@prefix doap: <http://usefulinc.com/ns/doap#> .
	2	@prefix doap-bugs: <http://ontologi.es/doap-bugs#> .
	3	@prefix doap-changeset: <http://ontologi.es/doap-changeset#> .
	4	@prefix doap-deps: <http://ontologi.es/doap-deps#> .
	5	@prefix foaf: <http://xmlns.com/foaf/0.1/> .
	6	@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> .
	7	@prefix xsd: <http://www.w3.org/2001/XMLSchema#> .
	8
	9	<http://dev.perl.org/licenses/>
	10	dc:title "the same terms as the perl 5 programming language system itself".
	11
	12	<http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/project>
	13	a doap:Project;
	14	dc:contributor <http://purl.org/NET/cpan-uri/person/tobyink>;
	15	doap-deps:test-requirement [ doap-deps:on "Test::More 0.61"^^doap-deps:CpanId ];
	16	doap:bug-database <http://rt.cpan.org/Dist/Display.html?Queue=HTML-HTML5-Entities>;
	17	doap:created "2011-10-06"^^xsd:date;
	18	doap:download-page <https://metacpan.org/release/HTML-HTML5-Entities>;
	19	doap:homepage <https://metacpan.org/release/HTML-HTML5-Entities>;
	20	doap:license <http://dev.perl.org/licenses/>;
	21	doap:maintainer [
	22	a foaf:Person;
	23	foaf:mbox <mailto:tobyink@cpan.org>;
	24	foaf:name "Toby Inkster";
	25	];
	26	doap:name "HTML-HTML5-Entities";
	27	doap:programming-language "Perl";
	28	doap:release <http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/v_0-001>, <http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/v_0-002>, <http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/v_0-003>, <http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/v_0-004>;
	29	doap:repository [
	30	a doap:GitRepository;
	31	doap:browse <https://github.com/tobyink/p5-html-html5-entities>;
	32	];
	33	doap:shortdesc "drop-in replacement for HTML::Entities".
	34
	35	<http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/v_0-001>
	36	a doap:Version;
	37	rdfs:label "Initial release";
	38	dc:issued "2011-10-07"^^xsd:date;
	39	doap:file-release <http://backpan.cpan.org/authors/id/T/TO/TOBYINK/HTML-HTML5-Entities-0.001.tar.gz>;
	40	doap:revision "0.001"^^xsd:string.
	41
	42	<http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/v_0-002>
	43	a doap:Version;
	44	dc:issued "2012-01-16"^^xsd:date;
	45	doap-changeset:changeset [
	46	doap-changeset:item [
	47	rdfs:label "%char2entity is now a more conservative mapping, based on XHTML 1.0 (but without apos). This makes it safer for serialising XHTML 1.x, HTML4 and HTML5 documents."@en;
	48	];
	49	doap-changeset:versus <http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/v_0-001>;
	50	];
	51	doap:file-release <http://backpan.cpan.org/authors/id/T/TO/TOBYINK/HTML-HTML5-Entities-0.002.tar.gz>;
	52	doap:revision "0.002"^^xsd:string.
	53
	54	<http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/v_0-003>
	55	a doap:Version;
	56	dc:issued "2012-06-26"^^xsd:date;
	57	doap-changeset:changeset [
	58	doap-changeset:item [ rdfs:label "Drop non-core dependencies."@en ];
	59	doap-changeset:versus <http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/v_0-002>;
	60	];
	61	doap:file-release <http://backpan.cpan.org/authors/id/T/TO/TOBYINK/HTML-HTML5-Entities-0.003.tar.gz>;
	62	doap:revision "0.003"^^xsd:string.
	63
	64	<http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/v_0-004>
	65	a doap:Version;
	66	dc:identifier "HTML-HTML5-Entities-0.004"^^xsd:string;
	67	dc:issued "2014-09-13"^^xsd:date;
	68	doap-changeset:changeset [
	69	doap-changeset:item [
	70	a doap-changeset:Packaging;
	71	rdfs:label "Switch to Dist::Inkt.";
	72	], [
	73	a doap-changeset:Bugfix;
	74	rdfs:label "Various RT#97659-related fixes.";
	75	doap-changeset:fixes <http://purl.org/NET/cpan-uri/rt/ticket/97659>;
	76	doap-changeset:thanks [
	77	rdfs:label "pa genyon";
	78	foaf:mbox <mailto:pagenyon@gmail.com>;
	79	];
	80	];
	81	];
	82	doap-changeset:released-by <http://purl.org/NET/cpan-uri/person/tobyink>;
	83	doap:file-release <http://backpan.cpan.org/authors/id/T/TO/TOBYINK/HTML-HTML5-Entities-0.004.tar.gz>;
	84	doap:revision "0.004"^^xsd:string.
	85
	86	<http://purl.org/NET/cpan-uri/rt/ticket/97659>
	87	a doap-bugs:Issue;
	88	doap-bugs:id "97659"^^xsd:string;
	89	doap-bugs:page <https://rt.cpan.org/Ticket/Display.html?id=97659>.
	90

-930

~~inc/Module/AutoInstall.pm~~ less more

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

-93

~~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 @ISA $ISCORE};
7		BEGIN {
8		$VERSION = '1.06';
9		@ISA = 'Module::Install::Base';
10		$ISCORE = 1;
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		my @features_require = Module::AutoInstall->import(
40		(@config ? (-config => \@config) : ()),
41		(@core ? (-core => \@core) : ()),
42		$self->features,
43		);
44
45		my %seen;
46		my @requires = map @$_, map @$_, grep ref, $self->requires;
47		while (my ($mod, $ver) = splice(@requires, 0, 2)) {
48		$seen{$mod}{$ver}++;
49		}
50		my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
51		while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
52		$seen{$mod}{$ver}++;
53		}
54		my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
55		while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) {
56		$seen{$mod}{$ver}++;
57		}
58
59		my @deduped;
60		while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
61		push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
62		}
63
64		$self->requires(@deduped);
65
66		$self->makemaker_args( Module::AutoInstall::_make_args() );
67
68		my $class = ref($self);
69		$self->postamble(
70		"# --- $class section:\n" .
71		Module::AutoInstall::postamble()
72		);
73		}
74
75		sub installdeps_target {
76		my ($self, @args) = @_;
77
78		$self->include('Module::AutoInstall');
79		require Module::AutoInstall;
80
81		Module::AutoInstall::_installdeps_target(1);
82
83		$self->auto_install(@args);
84		}
85
86		sub auto_install_now {
87		my $self = shift;
88		$self->auto_install(@_);
89		Module::AutoInstall::do_install();
90		}
91
92		1;

-45

~~inc/Module/Install/AutoManifest.pm~~ less more

0		#line 1
1		use strict;
2		use warnings;
3
4		package Module::Install::AutoManifest;
5
6		use Module::Install::Base;
7
8		BEGIN {
9		our $VERSION = '0.003';
10		our $ISCORE = 1;
11		our @ISA = qw(Module::Install::Base);
12		}
13
14		sub auto_manifest {
15		my ($self) = @_;
16
17		return unless $Module::Install::AUTHOR;
18
19		die "auto_manifest requested, but no MANIFEST.SKIP exists\n"
20		unless -e "MANIFEST.SKIP";
21
22		if (-e "MANIFEST") {
23		unlink('MANIFEST') or die "Can't remove MANIFEST: $!";
24		}
25
26		$self->postamble(<<"END");
27		create_distdir: manifest_clean manifest
28
29		distclean :: manifest_clean
30
31		manifest_clean:
32		\t\$(RM_F) MANIFEST
33		END
34
35		}
36
37		1;
38		__END__
39
40		#line 48
41
42		#line 131
43
44		1; # End of Module::Install::AutoManifest

-83

~~inc/Module/Install/Base.pm~~ less more

0		#line 1
1		package Module::Install::Base;
2
3		use strict 'vars';
4		use vars qw{$VERSION};
5		BEGIN {
6		$VERSION = '1.06';
7		}
8
9		# Suspend handler for "redefined" warnings
10		BEGIN {
11		my $w = $SIG{__WARN__};
12		$SIG{__WARN__} = sub { $w };
13		}
14
15		#line 42
16
17		sub new {
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		}
27
28		#line 61
29
30		sub AUTOLOAD {
31		local $@;
32		my $func = eval { shift->_top->autoload } or return;
33		goto &$func;
34		}
35
36		#line 75
37
38		sub _top {
39		$_[0]->{_top};
40		}
41
42		#line 90
43
44		sub admin {
45		$_[0]->_top->{admin}
46		or
47		Module::Install::Base::FakeAdmin->new;
48		}
49
50		#line 106
51
52		sub is_admin {
53		! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
54		}
55
56		sub DESTROY {}
57
58		package Module::Install::Base::FakeAdmin;
59
60		use vars qw{$VERSION};
61		BEGIN {
62		$VERSION = $Module::Install::Base::VERSION;
63		}
64
65		my $fake;
66
67		sub new {
68		$fake \|\|= bless(\@_, $_[0]);
69		}
70
71		sub AUTOLOAD {}
72
73		sub DESTROY {}
74
75		# Restore warning handler
76		BEGIN {
77		$SIG{__WARN__} = $SIG{__WARN__}->();
78		}
79
80		1;
81
82		#line 159

-154

~~inc/Module/Install/Can.pm~~ less more

0		#line 1
1		package Module::Install::Can;
2
3		use strict;
4		use Config ();
5		use ExtUtils::MakeMaker ();
6		use Module::Install::Base ();
7
8		use vars qw{$VERSION @ISA $ISCORE};
9		BEGIN {
10		$VERSION = '1.06';
11		@ISA = 'Module::Install::Base';
12		$ISCORE = 1;
13		}
14
15		# check if we can load some module
16		### Upgrade this to not have to load the module if possible
17		sub can_use {
18		my ($self, $mod, $ver) = @_;
19		$mod =~ s{::\|\\}{/}g;
20		$mod .= '.pm' unless $mod =~ /\.pm$/i;
21
22		my $pkg = $mod;
23		$pkg =~ s{/}{::}g;
24		$pkg =~ s{\.pm$}{}i;
25
26		local $@;
27		eval { require $mod; $pkg->VERSION($ver \|\| 0); 1 };
28		}
29
30		# Check if we can run some command
31		sub can_run {
32		my ($self, $cmd) = @_;
33
34		my $_cmd = $cmd;
35		return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
36
37		for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
38		next if $dir eq '';
39		require File::Spec;
40		my $abs = File::Spec->catfile($dir, $cmd);
41		return $abs if (-x $abs or $abs = MM->maybe_command($abs));
42		}
43
44		return;
45		}
46
47		# Can our C compiler environment build XS files
48		sub can_xs {
49		my $self = shift;
50
51		# Ensure we have the CBuilder module
52		$self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
53
54		# Do we have the configure_requires checker?
55		local $@;
56		eval "require ExtUtils::CBuilder;";
57		if ( $@ ) {
58		# They don't obey configure_requires, so it is
59		# someone old and delicate. Try to avoid hurting
60		# them by falling back to an older simpler test.
61		return $self->can_cc();
62		}
63
64		# Do we have a working C compiler
65		my $builder = ExtUtils::CBuilder->new(
66		quiet => 1,
67		);
68		unless ( $builder->have_compiler ) {
69		# No working C compiler
70		return 0;
71		}
72
73		# Write a C file representative of what XS becomes
74		require File::Temp;
75		my ( $FH, $tmpfile ) = File::Temp::tempfile(
76		"compilexs-XXXXX",
77		SUFFIX => '.c',
78		);
79		binmode $FH;
80		print $FH <<'END_C';
81		#include "EXTERN.h"
82		#include "perl.h"
83		#include "XSUB.h"
84
85		int main(int argc, char **argv) {
86		return 0;
87		}
88
89		int boot_sanexs() {
90		return 1;
91		}
92
93		END_C
94		close $FH;
95
96		# Can the C compiler access the same headers XS does
97		my @libs = ();
98		my $object = undef;
99		eval {
100		local $^W = 0;
101		$object = $builder->compile(
102		source => $tmpfile,
103		);
104		@libs = $builder->link(
105		objects => $object,
106		module_name => 'sanexs',
107		);
108		};
109		my $result = $@ ? 0 : 1;
110
111		# Clean up all the build files
112		foreach ( $tmpfile, $object, @libs ) {
113		next unless defined $_;
114		1 while unlink;
115		}
116
117		return $result;
118		}
119
120		# Can we locate a (the) C compiler
121		sub can_cc {
122		my $self = shift;
123		my @chunks = split(/ /, $Config::Config{cc}) or return;
124
125		# $Config{cc} may contain args; try to find out the program part
126		while (@chunks) {
127		return $self->can_run("@chunks") \|\| (pop(@chunks), next);
128		}
129
130		return;
131		}
132
133		# Fix Cygwin bug on maybe_command();
134		if ( $^O eq 'cygwin' ) {
135		require ExtUtils::MM_Cygwin;
136		require ExtUtils::MM_Win32;
137		if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
138		*ExtUtils::MM_Cygwin::maybe_command = sub {
139		my ($self, $file) = @_;
140		if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
141		ExtUtils::MM_Win32->maybe_command($file);
142		} else {
143		ExtUtils::MM_Unix->maybe_command($file);
144		}
145		}
146		}
147		}
148
149		1;
150
151		__END__
152
153		#line 236

-93

~~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 @ISA $ISCORE};
7		BEGIN {
8		$VERSION = '1.06';
9		@ISA = 'Module::Install::Base';
10		$ISCORE = 1;
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

~~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 @ISA $ISCORE};
7		BEGIN {
8		$VERSION = '1.06';
9		@ISA = 'Module::Install::Base';
10		$ISCORE = 1;
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;

-418

~~inc/Module/Install/Makefile.pm~~ less more

0		#line 1
1		package Module::Install::Makefile;
2
3		use strict 'vars';
4		use ExtUtils::MakeMaker ();
5		use Module::Install::Base ();
6		use Fcntl qw/:flock :seek/;
7
8		use vars qw{$VERSION @ISA $ISCORE};
9		BEGIN {
10		$VERSION = '1.06';
11		@ISA = 'Module::Install::Base';
12		$ISCORE = 1;
13		}
14
15		sub Makefile { $_[0] }
16
17		my %seen = ();
18
19		sub prompt {
20		shift;
21
22		# Infinite loop protection
23		my @c = caller();
24		if ( ++$seen{"$c[1]\|$c[2]\|$_[0]"} > 3 ) {
25		die "Caught an potential prompt infinite loop ($c[1]\|$c[2]\|$_[0])";
26		}
27
28		# In automated testing or non-interactive session, always use defaults
29		if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
30		local $ENV{PERL_MM_USE_DEFAULT} = 1;
31		goto &ExtUtils::MakeMaker::prompt;
32		} else {
33		goto &ExtUtils::MakeMaker::prompt;
34		}
35		}
36
37		# Store a cleaned up version of the MakeMaker version,
38		# since we need to behave differently in a variety of
39		# ways based on the MM version.
40		my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
41
42		# If we are passed a param, do a "newer than" comparison.
43		# Otherwise, just return the MakeMaker version.
44		sub makemaker {
45		( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
46		}
47
48		# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
49		# as we only need to know here whether the attribute is an array
50		# or a hash or something else (which may or may not be appendable).
51		my %makemaker_argtype = (
52		C => 'ARRAY',
53		CONFIG => 'ARRAY',
54		# CONFIGURE => 'CODE', # ignore
55		DIR => 'ARRAY',
56		DL_FUNCS => 'HASH',
57		DL_VARS => 'ARRAY',
58		EXCLUDE_EXT => 'ARRAY',
59		EXE_FILES => 'ARRAY',
60		FUNCLIST => 'ARRAY',
61		H => 'ARRAY',
62		IMPORTS => 'HASH',
63		INCLUDE_EXT => 'ARRAY',
64		LIBS => 'ARRAY', # ignore ''
65		MAN1PODS => 'HASH',
66		MAN3PODS => 'HASH',
67		META_ADD => 'HASH',
68		META_MERGE => 'HASH',
69		PL_FILES => 'HASH',
70		PM => 'HASH',
71		PMLIBDIRS => 'ARRAY',
72		PMLIBPARENTDIRS => 'ARRAY',
73		PREREQ_PM => 'HASH',
74		CONFIGURE_REQUIRES => 'HASH',
75		SKIP => 'ARRAY',
76		TYPEMAPS => 'ARRAY',
77		XS => 'HASH',
78		# VERSION => ['version',''], # ignore
79		# _KEEP_AFTER_FLUSH => '',
80
81		clean => 'HASH',
82		depend => 'HASH',
83		dist => 'HASH',
84		dynamic_lib=> 'HASH',
85		linkext => 'HASH',
86		macro => 'HASH',
87		postamble => 'HASH',
88		realclean => 'HASH',
89		test => 'HASH',
90		tool_autosplit => 'HASH',
91
92		# special cases where you can use makemaker_append
93		CCFLAGS => 'APPENDABLE',
94		DEFINE => 'APPENDABLE',
95		INC => 'APPENDABLE',
96		LDDLFLAGS => 'APPENDABLE',
97		LDFROM => 'APPENDABLE',
98		);
99
100		sub makemaker_args {
101		my ($self, %new_args) = @_;
102		my $args = ( $self->{makemaker_args} \|\|= {} );
103		foreach my $key (keys %new_args) {
104		if ($makemaker_argtype{$key}) {
105		if ($makemaker_argtype{$key} eq 'ARRAY') {
106		$args->{$key} = [] unless defined $args->{$key};
107		unless (ref $args->{$key} eq 'ARRAY') {
108		$args->{$key} = [$args->{$key}]
109		}
110		push @{$args->{$key}},
111		ref $new_args{$key} eq 'ARRAY'
112		? @{$new_args{$key}}
113		: $new_args{$key};
114		}
115		elsif ($makemaker_argtype{$key} eq 'HASH') {
116		$args->{$key} = {} unless defined $args->{$key};
117		foreach my $skey (keys %{ $new_args{$key} }) {
118		$args->{$key}{$skey} = $new_args{$key}{$skey};
119		}
120		}
121		elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
122		$self->makemaker_append($key => $new_args{$key});
123		}
124		}
125		else {
126		if (defined $args->{$key}) {
127		warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
128		}
129		$args->{$key} = $new_args{$key};
130		}
131		}
132		return $args;
133		}
134
135		# For mm args that take multiple space-seperated args,
136		# append an argument to the current list.
137		sub makemaker_append {
138		my $self = shift;
139		my $name = shift;
140		my $args = $self->makemaker_args;
141		$args->{$name} = defined $args->{$name}
142		? join( ' ', $args->{$name}, @_ )
143		: join( ' ', @_ );
144		}
145
146		sub build_subdirs {
147		my $self = shift;
148		my $subdirs = $self->makemaker_args->{DIR} \|\|= [];
149		for my $subdir (@_) {
150		push @$subdirs, $subdir;
151		}
152		}
153
154		sub clean_files {
155		my $self = shift;
156		my $clean = $self->makemaker_args->{clean} \|\|= {};
157		%$clean = (
158		%$clean,
159		FILES => join ' ', grep { length $_ } ($clean->{FILES} \|\| (), @_),
160		);
161		}
162
163		sub realclean_files {
164		my $self = shift;
165		my $realclean = $self->makemaker_args->{realclean} \|\|= {};
166		%$realclean = (
167		%$realclean,
168		FILES => join ' ', grep { length $_ } ($realclean->{FILES} \|\| (), @_),
169		);
170		}
171
172		sub libs {
173		my $self = shift;
174		my $libs = ref $_[0] ? shift : [ shift ];
175		$self->makemaker_args( LIBS => $libs );
176		}
177
178		sub inc {
179		my $self = shift;
180		$self->makemaker_args( INC => shift );
181		}
182
183		sub _wanted_t {
184		}
185
186		sub tests_recursive {
187		my $self = shift;
188		my $dir = shift \|\| 't';
189		unless ( -d $dir ) {
190		die "tests_recursive dir '$dir' does not exist";
191		}
192		my %tests = map { $_ => 1 } split / /, ($self->tests \|\| '');
193		require File::Find;
194		File::Find::find(
195		sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
196		$dir
197		);
198		$self->tests( join ' ', sort keys %tests );
199		}
200
201		sub write {
202		my $self = shift;
203		die "&Makefile->write() takes no arguments\n" if @_;
204
205		# Check the current Perl version
206		my $perl_version = $self->perl_version;
207		if ( $perl_version ) {
208		eval "use $perl_version; 1"
209		or die "ERROR: perl: Version $] is installed, "
210		. "but we need version >= $perl_version";
211		}
212
213		# Make sure we have a new enough MakeMaker
214		require ExtUtils::MakeMaker;
215
216		if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
217		# This previous attempted to inherit the version of
218		# ExtUtils::MakeMaker in use by the module author, but this
219		# was found to be untenable as some authors build releases
220		# using future dev versions of EU:MM that nobody else has.
221		# Instead, #toolchain suggests we use 6.59 which is the most
222		# stable version on CPAN at time of writing and is, to quote
223		# ribasushi, "not terminally fucked, > and tested enough".
224		# TODO: We will now need to maintain this over time to push
225		# the version up as new versions are released.
226		$self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
227		$self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
228		} else {
229		# Allow legacy-compatibility with 5.005 by depending on the
230		# most recent EU:MM that supported 5.005.
231		$self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
232		$self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
233		}
234
235		# Generate the MakeMaker params
236		my $args = $self->makemaker_args;
237		$args->{DISTNAME} = $self->name;
238		$args->{NAME} = $self->module_name \|\| $self->name;
239		$args->{NAME} =~ s/-/::/g;
240		$args->{VERSION} = $self->version or die <<'EOT';
241		ERROR: Can't determine distribution version. Please specify it
242		explicitly via 'version' in Makefile.PL, or set a valid $VERSION
243		in a module, and provide its file path via 'version_from' (or
244		'all_from' if you prefer) in Makefile.PL.
245		EOT
246
247		if ( $self->tests ) {
248		my @tests = split ' ', $self->tests;
249		my %seen;
250		$args->{test} = {
251		TESTS => (join ' ', grep {!$seen{$_}++} @tests),
252		};
253		} elsif ( $Module::Install::ExtraTests::use_extratests ) {
254		# Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
255		# So, just ignore our xt tests here.
256		} elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
257		$args->{test} = {
258		TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
259		};
260		}
261		if ( $] >= 5.005 ) {
262		$args->{ABSTRACT} = $self->abstract;
263		$args->{AUTHOR} = join ', ', @{$self->author \|\| []};
264		}
265		if ( $self->makemaker(6.10) ) {
266		$args->{NO_META} = 1;
267		#$args->{NO_MYMETA} = 1;
268		}
269		if ( $self->makemaker(6.17) and $self->sign ) {
270		$args->{SIGN} = 1;
271		}
272		unless ( $self->is_admin ) {
273		delete $args->{SIGN};
274		}
275		if ( $self->makemaker(6.31) and $self->license ) {
276		$args->{LICENSE} = $self->license;
277		}
278
279		my $prereq = ($args->{PREREQ_PM} \|\|= {});
280		%$prereq = ( %$prereq,
281		map { @$_ } # flatten [module => version]
282		map { @$_ }
283		grep $_,
284		($self->requires)
285		);
286
287		# Remove any reference to perl, PREREQ_PM doesn't support it
288		delete $args->{PREREQ_PM}->{perl};
289
290		# Merge both kinds of requires into BUILD_REQUIRES
291		my $build_prereq = ($args->{BUILD_REQUIRES} \|\|= {});
292		%$build_prereq = ( %$build_prereq,
293		map { @$_ } # flatten [module => version]
294		map { @$_ }
295		grep $_,
296		($self->configure_requires, $self->build_requires)
297		);
298
299		# Remove any reference to perl, BUILD_REQUIRES doesn't support it
300		delete $args->{BUILD_REQUIRES}->{perl};
301
302		# Delete bundled dists from prereq_pm, add it to Makefile DIR
303		my $subdirs = ($args->{DIR} \|\| []);
304		if ($self->bundles) {
305		my %processed;
306		foreach my $bundle (@{ $self->bundles }) {
307		my ($mod_name, $dist_dir) = @$bundle;
308		delete $prereq->{$mod_name};
309		$dist_dir = File::Basename::basename($dist_dir); # dir for building this module
310		if (not exists $processed{$dist_dir}) {
311		if (-d $dist_dir) {
312		# List as sub-directory to be processed by make
313		push @$subdirs, $dist_dir;
314		}
315		# Else do nothing: the module is already present on the system
316		$processed{$dist_dir} = undef;
317		}
318		}
319		}
320
321		unless ( $self->makemaker('6.55_03') ) {
322		%$prereq = (%$prereq,%$build_prereq);
323		delete $args->{BUILD_REQUIRES};
324		}
325
326		if ( my $perl_version = $self->perl_version ) {
327		eval "use $perl_version; 1"
328		or die "ERROR: perl: Version $] is installed, "
329		. "but we need version >= $perl_version";
330
331		if ( $self->makemaker(6.48) ) {
332		$args->{MIN_PERL_VERSION} = $perl_version;
333		}
334		}
335
336		if ($self->installdirs) {
337		warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
338		$args->{INSTALLDIRS} = $self->installdirs;
339		}
340
341		my %args = map {
342		( $_ => $args->{$_} ) } grep {defined($args->{$_} )
343		} keys %$args;
344
345		my $user_preop = delete $args{dist}->{PREOP};
346		if ( my $preop = $self->admin->preop($user_preop) ) {
347		foreach my $key ( keys %$preop ) {
348		$args{dist}->{$key} = $preop->{$key};
349		}
350		}
351
352		my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
353		$self->fix_up_makefile($mm->{FIRST_MAKEFILE} \|\| 'Makefile');
354		}
355
356		sub fix_up_makefile {
357		my $self = shift;
358		my $makefile_name = shift;
359		my $top_class = ref($self->_top) \|\| '';
360		my $top_version = $self->_top->VERSION \|\| '';
361
362		my $preamble = $self->preamble
363		? "# Preamble by $top_class $top_version\n"
364		. $self->preamble
365		: '';
366		my $postamble = "# Postamble by $top_class $top_version\n"
367		. ($self->postamble \|\| '');
368
369		local *MAKEFILE;
370		open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
371		eval { flock MAKEFILE, LOCK_EX };
372		my $makefile = do { local $/; <MAKEFILE> };
373
374		$makefile =~ s/\b(test_harness$\$\(TEST_VERBOSE$, )/$1'inc', /;
375		$makefile =~ s/( -I\$$INST_ARCHLIB$)/ -Iinc$1/g;
376		$makefile =~ s/( "-I\$$INST_LIB$")/ "-Iinc"$1/g;
377		$makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
378		$makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
379
380		# Module::Install will never be used to build the Core Perl
381		# Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
382		# PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
383		$makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
384		#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
385
386		# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
387		$makefile =~ s/(\"?)-I\$$PERL_LIB$\1//g;
388
389		# XXX - This is currently unused; not sure if it breaks other MM-users
390		# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
391
392		seek MAKEFILE, 0, SEEK_SET;
393		truncate MAKEFILE, 0;
394		print MAKEFILE "$preamble$makefile$postamble" or die $!;
395		close MAKEFILE or die $!;
396
397		1;
398		}
399
400		sub preamble {
401		my ($self, $text) = @_;
402		$self->{preamble} = $text . $self->{preamble} if defined $text;
403		$self->{preamble};
404		}
405
406		sub postamble {
407		my ($self, $text) = @_;
408		$self->{postamble} \|\|= $self->admin->postamble;
409		$self->{postamble} .= $text if defined $text;
410		$self->{postamble}
411		}
412
413		1;
414
415		__END__
416
417		#line 544

-722

~~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 @ISA $ISCORE};
7		BEGIN {
8		$VERSION = '1.06';
9		@ISA = 'Module::Install::Base';
10		$ISCORE = 1;
11		}
12
13		my @boolean_keys = qw{
14		sign
15		};
16
17		my @scalar_keys = qw{
18		name
19		module_name
20		abstract
21		version
22		distribution_type
23		tests
24		installdirs
25		};
26
27		my @tuple_keys = qw{
28		configure_requires
29		build_requires
30		requires
31		recommends
32		bundles
33		resources
34		};
35
36		my @resource_keys = qw{
37		homepage
38		bugtracker
39		repository
40		};
41
42		my @array_keys = qw{
43		keywords
44		author
45		};
46
47		*authors = \&author;
48
49		sub Meta { shift }
50		sub Meta_BooleanKeys { @boolean_keys }
51		sub Meta_ScalarKeys { @scalar_keys }
52		sub Meta_TupleKeys { @tuple_keys }
53		sub Meta_ResourceKeys { @resource_keys }
54		sub Meta_ArrayKeys { @array_keys }
55
56		foreach my $key ( @boolean_keys ) {
57		*$key = sub {
58		my $self = shift;
59		if ( defined wantarray and not @_ ) {
60		return $self->{values}->{$key};
61		}
62		$self->{values}->{$key} = ( @_ ? $_[0] : 1 );
63		return $self;
64		};
65		}
66
67		foreach my $key ( @scalar_keys ) {
68		*$key = sub {
69		my $self = shift;
70		return $self->{values}->{$key} if defined wantarray and !@_;
71		$self->{values}->{$key} = shift;
72		return $self;
73		};
74		}
75
76		foreach my $key ( @array_keys ) {
77		*$key = sub {
78		my $self = shift;
79		return $self->{values}->{$key} if defined wantarray and !@_;
80		$self->{values}->{$key} \|\|= [];
81		push @{$self->{values}->{$key}}, @_;
82		return $self;
83		};
84		}
85
86		foreach my $key ( @resource_keys ) {
87		*$key = sub {
88		my $self = shift;
89		unless ( @_ ) {
90		return () unless $self->{values}->{resources};
91		return map { $_->[1] }
92		grep { $_->[0] eq $key }
93		@{ $self->{values}->{resources} };
94		}
95		return $self->{values}->{resources}->{$key} unless @_;
96		my $uri = shift or die(
97		"Did not provide a value to $key()"
98		);
99		$self->resources( $key => $uri );
100		return 1;
101		};
102		}
103
104		foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
105		*$key = sub {
106		my $self = shift;
107		return $self->{values}->{$key} unless @_;
108		my @added;
109		while ( @_ ) {
110		my $module = shift or last;
111		my $version = shift \|\| 0;
112		push @added, [ $module, $version ];
113		}
114		push @{ $self->{values}->{$key} }, @added;
115		return map {@$_} @added;
116		};
117		}
118
119		# Resource handling
120		my %lc_resource = map { $_ => 1 } qw{
121		homepage
122		license
123		bugtracker
124		repository
125		};
126
127		sub resources {
128		my $self = shift;
129		while ( @_ ) {
130		my $name = shift or last;
131		my $value = shift or next;
132		if ( $name eq lc $name and ! $lc_resource{$name} ) {
133		die("Unsupported reserved lowercase resource '$name'");
134		}
135		$self->{values}->{resources} \|\|= [];
136		push @{ $self->{values}->{resources} }, [ $name, $value ];
137		}
138		$self->{values}->{resources};
139		}
140
141		# Aliases for build_requires that will have alternative
142		# meanings in some future version of META.yml.
143		sub test_requires { shift->build_requires(@_) }
144		sub install_requires { shift->build_requires(@_) }
145
146		# Aliases for installdirs options
147		sub install_as_core { $_[0]->installdirs('perl') }
148		sub install_as_cpan { $_[0]->installdirs('site') }
149		sub install_as_site { $_[0]->installdirs('site') }
150		sub install_as_vendor { $_[0]->installdirs('vendor') }
151
152		sub dynamic_config {
153		my $self = shift;
154		my $value = @_ ? shift : 1;
155		if ( $self->{values}->{dynamic_config} ) {
156		# Once dynamic we never change to static, for safety
157		return 0;
158		}
159		$self->{values}->{dynamic_config} = $value ? 1 : 0;
160		return 1;
161		}
162
163		# Convenience command
164		sub static_config {
165		shift->dynamic_config(0);
166		}
167
168		sub perl_version {
169		my $self = shift;
170		return $self->{values}->{perl_version} unless @_;
171		my $version = shift or die(
172		"Did not provide a value to perl_version()"
173		);
174
175		# Normalize the version
176		$version = $self->_perl_version($version);
177
178		# We don't support the really old versions
179		unless ( $version >= 5.005 ) {
180		die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
181		}
182
183		$self->{values}->{perl_version} = $version;
184		}
185
186		sub all_from {
187		my ( $self, $file ) = @_;
188
189		unless ( defined($file) ) {
190		my $name = $self->name or die(
191		"all_from called with no args without setting name() first"
192		);
193		$file = join('/', 'lib', split(/-/, $name)) . '.pm';
194		$file =~ s{.*/}{} unless -e $file;
195		unless ( -e $file ) {
196		die("all_from cannot find $file from $name");
197		}
198		}
199		unless ( -f $file ) {
200		die("The path '$file' does not exist, or is not a file");
201		}
202
203		$self->{values}{all_from} = $file;
204
205		# Some methods pull from POD instead of code.
206		# If there is a matching .pod, use that instead
207		my $pod = $file;
208		$pod =~ s/\.pm$/.pod/i;
209		$pod = $file unless -e $pod;
210
211		# Pull the different values
212		$self->name_from($file) unless $self->name;
213		$self->version_from($file) unless $self->version;
214		$self->perl_version_from($file) unless $self->perl_version;
215		$self->author_from($pod) unless @{$self->author \|\| []};
216		$self->license_from($pod) unless $self->license;
217		$self->abstract_from($pod) unless $self->abstract;
218
219		return 1;
220		}
221
222		sub provides {
223		my $self = shift;
224		my $provides = ( $self->{values}->{provides} \|\|= {} );
225		%$provides = (%$provides, @_) if @_;
226		return $provides;
227		}
228
229		sub auto_provides {
230		my $self = shift;
231		return $self unless $self->is_admin;
232		unless (-e 'MANIFEST') {
233		warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
234		return $self;
235		}
236		# Avoid spurious warnings as we are not checking manifest here.
237		local $SIG{__WARN__} = sub {1};
238		require ExtUtils::Manifest;
239		local *ExtUtils::Manifest::manicheck = sub { return };
240
241		require Module::Build;
242		my $build = Module::Build->new(
243		dist_name => $self->name,
244		dist_version => $self->version,
245		license => $self->license,
246		);
247		$self->provides( %{ $build->find_dist_packages \|\| {} } );
248		}
249
250		sub feature {
251		my $self = shift;
252		my $name = shift;
253		my $features = ( $self->{values}->{features} \|\|= [] );
254		my $mods;
255
256		if ( @_ == 1 and ref( $_[0] ) ) {
257		# The user used ->feature like ->features by passing in the second
258		# argument as a reference. Accomodate for that.
259		$mods = $_[0];
260		} else {
261		$mods = \@_;
262		}
263
264		my $count = 0;
265		push @$features, (
266		$name => [
267		map {
268		ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
269		} @$mods
270		]
271		);
272
273		return @$features;
274		}
275
276		sub features {
277		my $self = shift;
278		while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
279		$self->feature( $name, @$mods );
280		}
281		return $self->{values}->{features}
282		? @{ $self->{values}->{features} }
283		: ();
284		}
285
286		sub no_index {
287		my $self = shift;
288		my $type = shift;
289		push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
290		return $self->{values}->{no_index};
291		}
292
293		sub read {
294		my $self = shift;
295		$self->include_deps( 'YAML::Tiny', 0 );
296
297		require YAML::Tiny;
298		my $data = YAML::Tiny::LoadFile('META.yml');
299
300		# Call methods explicitly in case user has already set some values.
301		while ( my ( $key, $value ) = each %$data ) {
302		next unless $self->can($key);
303		if ( ref $value eq 'HASH' ) {
304		while ( my ( $module, $version ) = each %$value ) {
305		$self->can($key)->($self, $module => $version );
306		}
307		} else {
308		$self->can($key)->($self, $value);
309		}
310		}
311		return $self;
312		}
313
314		sub write {
315		my $self = shift;
316		return $self unless $self->is_admin;
317		$self->admin->write_meta;
318		return $self;
319		}
320
321		sub version_from {
322		require ExtUtils::MM_Unix;
323		my ( $self, $file ) = @_;
324		$self->version( ExtUtils::MM_Unix->parse_version($file) );
325
326		# for version integrity check
327		$self->makemaker_args( VERSION_FROM => $file );
328		}
329
330		sub abstract_from {
331		require ExtUtils::MM_Unix;
332		my ( $self, $file ) = @_;
333		$self->abstract(
334		bless(
335		{ DISTNAME => $self->name },
336		'ExtUtils::MM_Unix'
337		)->parse_abstract($file)
338		);
339		}
340
341		# Add both distribution and module name
342		sub name_from {
343		my ($self, $file) = @_;
344		if (
345		Module::Install::_read($file) =~ m/
346		^ \s*
347		package \s*
348		([\w:]+)
349		\s* ;
350		/ixms
351		) {
352		my ($name, $module_name) = ($1, $1);
353		$name =~ s{::}{-}g;
354		$self->name($name);
355		unless ( $self->module_name ) {
356		$self->module_name($module_name);
357		}
358		} else {
359		die("Cannot determine name from $file\n");
360		}
361		}
362
363		sub _extract_perl_version {
364		if (
365		$_[0] =~ m/
366		^\s*
367		(?:use\|require) \s*
368		v?
369		([\d_\.]+)
370		\s* ;
371		/ixms
372		) {
373		my $perl_version = $1;
374		$perl_version =~ s{_}{}g;
375		return $perl_version;
376		} else {
377		return;
378		}
379		}
380
381		sub perl_version_from {
382		my $self = shift;
383		my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
384		if ($perl_version) {
385		$self->perl_version($perl_version);
386		} else {
387		warn "Cannot determine perl version info from $_[0]\n";
388		return;
389		}
390		}
391
392		sub author_from {
393		my $self = shift;
394		my $content = Module::Install::_read($_[0]);
395		if ($content =~ m/
396		=head \d \s+ (?:authors?)\b \s*
397		([^\n]*)
398		\|
399		=head \d \s+ (?:licen[cs]e\|licensing\|copyright\|legal)\b \s*
400		.? copyright .? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
401		([^\n]*)
402		/ixms) {
403		my $author = $1 \|\| $2;
404
405		# XXX: ugly but should work anyway...
406		if (eval "require Pod::Escapes; 1") {
407		# Pod::Escapes has a mapping table.
408		# It's in core of perl >= 5.9.3, and should be installed
409		# as one of the Pod::Simple's prereqs, which is a prereq
410		# of Pod::Text 3.x (see also below).
411		$author =~ s{ E<( (\d+) \| ([A-Za-z]+) )> }
412		{
413		defined $2
414		? chr($2)
415		: defined $Pod::Escapes::Name2character_number{$1}
416		? chr($Pod::Escapes::Name2character_number{$1})
417		: do {
418		warn "Unknown escape: E<$1>";
419		"E<$1>";
420		};
421		}gex;
422		}
423		elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
424		# Pod::Text < 3.0 has yet another mapping table,
425		# though the table name of 2.x and 1.x are different.
426		# (1.x is in core of Perl < 5.6, 2.x is in core of
427		# Perl < 5.9.3)
428		my $mapping = ($Pod::Text::VERSION < 2)
429		? \%Pod::Text::HTML_Escapes
430		: \%Pod::Text::ESCAPES;
431		$author =~ s{ E<( (\d+) \| ([A-Za-z]+) )> }
432		{
433		defined $2
434		? chr($2)
435		: defined $mapping->{$1}
436		? $mapping->{$1}
437		: do {
438		warn "Unknown escape: E<$1>";
439		"E<$1>";
440		};
441		}gex;
442		}
443		else {
444		$author =~ s{E<lt>}{<}g;
445		$author =~ s{E<gt>}{>}g;
446		}
447		$self->author($author);
448		} else {
449		warn "Cannot determine author info from $_[0]\n";
450		}
451		}
452
453		#Stolen from M::B
454		my %license_urls = (
455		perl => 'http://dev.perl.org/licenses/',
456		apache => 'http://apache.org/licenses/LICENSE-2.0',
457		apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
458		artistic => 'http://opensource.org/licenses/artistic-license.php',
459		artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
460		lgpl => 'http://opensource.org/licenses/lgpl-license.php',
461		lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
462		lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
463		bsd => 'http://opensource.org/licenses/bsd-license.php',
464		gpl => 'http://opensource.org/licenses/gpl-license.php',
465		gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
466		gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
467		mit => 'http://opensource.org/licenses/mit-license.php',
468		mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
469		open_source => undef,
470		unrestricted => undef,
471		restrictive => undef,
472		unknown => undef,
473		);
474
475		sub license {
476		my $self = shift;
477		return $self->{values}->{license} unless @_;
478		my $license = shift or die(
479		'Did not provide a value to license()'
480		);
481		$license = __extract_license($license) \|\| lc $license;
482		$self->{values}->{license} = $license;
483
484		# Automatically fill in license URLs
485		if ( $license_urls{$license} ) {
486		$self->resources( license => $license_urls{$license} );
487		}
488
489		return 1;
490		}
491
492		sub _extract_license {
493		my $pod = shift;
494		my $matched;
495		return __extract_license(
496		($matched) = $pod =~ m/
497		(=head \d \s+ L(?i:ICEN[CS]E\|ICENSING)\b.*?)
498		(=head \d.\|=cut.\|)\z
499		/xms
500		) \|\| __extract_license(
501		($matched) = $pod =~ m/
502		(=head \d \s+ (?:C(?i:OPYRIGHTS?)\|L(?i:EGAL))\b.*?)
503		(=head \d.\|=cut.\|)\z
504		/xms
505		);
506		}
507
508		sub __extract_license {
509		my $license_text = shift or return;
510		my @phrases = (
511		'(?:under )?the same (?:terms\|license) as (?:perl\|the perl (?:\d )?programming language)' => 'perl', 1,
512		'(?:under )?the terms of (?:perl\|the perl programming language) itself' => 'perl', 1,
513		'Artistic and GPL' => 'perl', 1,
514		'GNU general public license' => 'gpl', 1,
515		'GNU public license' => 'gpl', 1,
516		'GNU lesser general public license' => 'lgpl', 1,
517		'GNU lesser public license' => 'lgpl', 1,
518		'GNU library general public license' => 'lgpl', 1,
519		'GNU library public license' => 'lgpl', 1,
520		'GNU Free Documentation license' => 'unrestricted', 1,
521		'GNU Affero General Public License' => 'open_source', 1,
522		'(?:Free)?BSD license' => 'bsd', 1,
523		'Artistic license 2\.0' => 'artistic_2', 1,
524		'Artistic license' => 'artistic', 1,
525		'Apache (?:Software )?license' => 'apache', 1,
526		'GPL' => 'gpl', 1,
527		'LGPL' => 'lgpl', 1,
528		'BSD' => 'bsd', 1,
529		'Artistic' => 'artistic', 1,
530		'MIT' => 'mit', 1,
531		'Mozilla Public License' => 'mozilla', 1,
532		'Q Public License' => 'open_source', 1,
533		'OpenSSL License' => 'unrestricted', 1,
534		'SSLeay License' => 'unrestricted', 1,
535		'zlib License' => 'open_source', 1,
536		'proprietary' => 'proprietary', 0,
537		);
538		while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
539		$pattern =~ s#\s+#\\s+#gs;
540		if ( $license_text =~ /\b$pattern\b/i ) {
541		return $license;
542		}
543		}
544		return '';
545		}
546
547		sub license_from {
548		my $self = shift;
549		if (my $license=_extract_license(Module::Install::_read($_[0]))) {
550		$self->license($license);
551		} else {
552		warn "Cannot determine license info from $_[0]\n";
553		return 'unknown';
554		}
555		}
556
557		sub _extract_bugtracker {
558		my @links = $_[0] =~ m#L<(
559		https?\Q://rt.cpan.org/\E[^>]+\|
560		https?\Q://github.com/\E[\w_]+/[\w_]+/issues\|
561		https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
562		)>#gx;
563		my %links;
564		@links{@links}=();
565		@links=keys %links;
566		return @links;
567		}
568
569		sub bugtracker_from {
570		my $self = shift;
571		my $content = Module::Install::_read($_[0]);
572		my @links = _extract_bugtracker($content);
573		unless ( @links ) {
574		warn "Cannot determine bugtracker info from $_[0]\n";
575		return 0;
576		}
577		if ( @links > 1 ) {
578		warn "Found more than one bugtracker link in $_[0]\n";
579		return 0;
580		}
581
582		# Set the bugtracker
583		bugtracker( $links[0] );
584		return 1;
585		}
586
587		sub requires_from {
588		my $self = shift;
589		my $content = Module::Install::_readperl($_[0]);
590		my @requires = $content =~ m/^use\s+([^\W\d]\w(?:::\w+))\s+(v?[\d\.]+)/mg;
591		while ( @requires ) {
592		my $module = shift @requires;
593		my $version = shift @requires;
594		$self->requires( $module => $version );
595		}
596		}
597
598		sub test_requires_from {
599		my $self = shift;
600		my $content = Module::Install::_readperl($_[0]);
601		my @requires = $content =~ m/^use\s+([^\W\d]\w(?:::\w+))\s+([\d\.]+)/mg;
602		while ( @requires ) {
603		my $module = shift @requires;
604		my $version = shift @requires;
605		$self->test_requires( $module => $version );
606		}
607		}
608
609		# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
610		# numbers (eg, 5.006001 or 5.008009).
611		# Also, convert double-part versions (eg, 5.8)
612		sub _perl_version {
613		my $v = $_[-1];
614		$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
615		$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0\|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 \|\| 0)/e;
616		$v =~ s/(\.\d\d\d)000$/$1/;
617		$v =~ s/_.+$//;
618		if ( ref($v) ) {
619		# Numify
620		$v = $v + 0;
621		}
622		return $v;
623		}
624
625		sub add_metadata {
626		my $self = shift;
627		my %hash = @_;
628		for my $key (keys %hash) {
629		warn "add_metadata: $key is not prefixed with 'x_'.\n" .
630		"Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
631		$self->{values}->{$key} = $hash{$key};
632		}
633		}
634
635
636		######################################################################
637		# MYMETA Support
638
639		sub WriteMyMeta {
640		die "WriteMyMeta has been deprecated";
641		}
642
643		sub write_mymeta_yaml {
644		my $self = shift;
645
646		# We need YAML::Tiny to write the MYMETA.yml file
647		unless ( eval { require YAML::Tiny; 1; } ) {
648		return 1;
649		}
650
651		# Generate the data
652		my $meta = $self->_write_mymeta_data or return 1;
653
654		# Save as the MYMETA.yml file
655		print "Writing MYMETA.yml\n";
656		YAML::Tiny::DumpFile('MYMETA.yml', $meta);
657		}
658
659		sub write_mymeta_json {
660		my $self = shift;
661
662		# We need JSON to write the MYMETA.json file
663		unless ( eval { require JSON; 1; } ) {
664		return 1;
665		}
666
667		# Generate the data
668		my $meta = $self->_write_mymeta_data or return 1;
669
670		# Save as the MYMETA.yml file
671		print "Writing MYMETA.json\n";
672		Module::Install::_write(
673		'MYMETA.json',
674		JSON->new->pretty(1)->canonical->encode($meta),
675		);
676		}
677
678		sub _write_mymeta_data {
679		my $self = shift;
680
681		# If there's no existing META.yml there is nothing we can do
682		return undef unless -f 'META.yml';
683
684		# We need Parse::CPAN::Meta to load the file
685		unless ( eval { require Parse::CPAN::Meta; 1; } ) {
686		return undef;
687		}
688
689		# Merge the perl version into the dependencies
690		my $val = $self->Meta->{values};
691		my $perl = delete $val->{perl_version};
692		if ( $perl ) {
693		$val->{requires} \|\|= [];
694		my $requires = $val->{requires};
695
696		# Canonize to three-dot version after Perl 5.6
697		if ( $perl >= 5.006 ) {
698		$perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2\|\|0), int($3\|\|0))}e
699		}
700		unshift @$requires, [ perl => $perl ];
701		}
702
703		# Load the advisory META.yml file
704		my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
705		my $meta = $yaml[0];
706
707		# Overwrite the non-configure dependency hashs
708		delete $meta->{requires};
709		delete $meta->{build_requires};
710		delete $meta->{recommends};
711		if ( exists $val->{requires} ) {
712		$meta->{requires} = { map { @$_ } @{ $val->{requires} } };
713		}
714		if ( exists $val->{build_requires} ) {
715		$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
716		}
717
718		return $meta;
719		}
720
721		1;

-323

~~inc/Module/Install/Package.pm~~ less more

0		#line 1
1		##
2		# name: Module::Install::Package
3		# abstract: Module::Install support for Module::Package
4		# author: Ingy döt Net <ingy@cpan.org>
5		# license: perl
6		# copyright: 2011
7		# see:
8		# - Module::Package
9
10		# This module contains the Module::Package logic that must be available to
11		# both the Author and the End User. Author-only logic goes in a
12		# Module::Package::Plugin subclass.
13		package Module::Install::Package;
14		use strict;
15		use Module::Install::Base;
16		use vars qw'@ISA $VERSION';
17		@ISA = 'Module::Install::Base';
18		$VERSION = '0.30';
19
20		#-----------------------------------------------------------------------------#
21		# XXX BOOTBUGHACK
22		# This is here to try to get us out of Module-Package-0.11 cpantesters hell...
23		# Remove this when the situation has blown over.
24		sub pkg {
25		*inc::Module::Package::VERSION = sub { $VERSION };
26		my $self = shift;
27		$self->module_package_internals_init($@);
28		}
29
30		#-----------------------------------------------------------------------------#
31		# We allow the author to specify key/value options after the plugin. These
32		# options need to be available both at author time and install time.
33		#-----------------------------------------------------------------------------#
34		# OO accessor for command line options:
35		sub package_options {
36		@_>1?($_[0]->{package_options}=$_[1]):$_[0]->{package_options}}
37
38		my $default_options = {
39		deps_list => 1,
40		install_bin => 1,
41		install_share => 1,
42		manifest_skip => 1,
43		requires_from => 1,
44		};
45
46		#-----------------------------------------------------------------------------#
47		# Module::Install plugin directives. Use long, ugly names to not pollute the
48		# Module::Install plugin namespace. These are only intended to be called from
49		# Module::Package.
50		#-----------------------------------------------------------------------------#
51
52		# Module::Package starts off life as a normal call to this Module::Install
53		# plugin directive:
54		my $module_install_plugin;
55		my $module_package_plugin;
56		my $module_package_dist_plugin;
57		# XXX ARGVHACK This @argv thing is a temporary fix for an ugly bug somewhere in the
58		# Wikitext module usage.
59		my @argv;
60		sub module_package_internals_init {
61		my $self = $module_install_plugin = shift;
62		my ($plugin_spec, %options) = @_;
63		$self->package_options({%$default_options, %options});
64
65		if ($module_install_plugin->is_admin) {
66		$module_package_plugin = $self->_load_plugin($plugin_spec);
67		$module_package_plugin->mi($module_install_plugin);
68		$module_package_plugin->version_check($VERSION);
69		}
70		else {
71		$module_package_dist_plugin = $self->_load_dist_plugin($plugin_spec);
72		$module_package_dist_plugin->mi($module_install_plugin) if ref $module_package_dist_plugin;
73		}
74		# NOTE - This is the point in time where the body of Makefile.PL runs...
75		return;
76
77		sub INIT {
78		return unless $module_install_plugin;
79		return if $Module::Package::ERROR;
80		eval {
81		if ($module_install_plugin->is_admin) {
82		$module_package_plugin->initial();
83		$module_package_plugin->main();
84		}
85		else {
86		$module_install_plugin->_initial();
87		$module_package_dist_plugin->_initial() if ref $module_package_dist_plugin;
88		$module_install_plugin->_main();
89		$module_package_dist_plugin->_main() if ref $module_package_dist_plugin;
90		}
91		};
92		if ($@) {
93		$Module::Package::ERROR = $@;
94		die $@;
95		}
96		@argv = @ARGV; # XXX ARGVHACK
97		}
98
99		# If this Module::Install plugin was used (by Module::Package) then wrap
100		# up any loose ends. This will get called after Makefile.PL has completed.
101		sub END {
102		@ARGV = @argv; # XXX ARGVHACK
103		return unless $module_install_plugin;
104		return if $Module::Package::ERROR;
105		$module_package_plugin
106		? do {
107		$module_package_plugin->final;
108		$module_package_plugin->replicate_module_package;
109		}
110		: do {
111		$module_install_plugin->_final;
112		$module_package_dist_plugin->_final() if ref $module_package_dist_plugin;
113		}
114		}
115		}
116
117		# Module::Package, Module::Install::Package and Module::Package::Plugin
118		# must all have the same version. Seems wise.
119		sub module_package_internals_version_check {
120		my ($self, $version) = @_;
121		return if $version < 0.1800001; # XXX BOOTBUGHACK!!
122		die <<"..." unless $version == $VERSION;
123
124		Error! Something has gone awry:
125		Module::Package version=$version is using
126		Module::Install::Package version=$VERSION
127		If you are the author of this module, try upgrading Module::Package.
128		Otherwise, please notify the author of this error.
129
130		...
131		}
132
133		# Find and load the author side plugin:
134		sub _load_plugin {
135		my ($self, $spec, $namespace) = @_;
136		$spec \|\|= '';
137		$namespace \|\|= 'Module::Package';
138		my $version = '';
139		$Module::Package::plugin_version = 0;
140		if ($spec =~ s/\s+(\S+)\s*//) {
141		$version = $1;
142		$Module::Package::plugin_version = $version;
143		}
144		my ($module, $plugin) =
145		not($spec) ? ('Plugin', "Plugin::basic") :
146		($spec =~ /^\w(\w\|::)*$/) ? ($spec, $spec) :
147		($spec =~ /^:(\w+)$/) ? ('Plugin', "Plugin::$1") :
148		($spec =~ /^(\S*\w):(\w+)$/) ? ($1, "$1::$2") :
149		die "$spec is invalid";
150		$module = "${namespace}::${module}";
151		$plugin = "${namespace}::${plugin}";
152		eval "use $module $version (); 1" or die $@;
153		return $plugin->new();
154		}
155
156		# Find and load the user side plugin:
157		sub _load_dist_plugin {
158		my ($self, $spec, $namespace) = @_;
159		$spec \|\|= '';
160		$namespace \|\|= 'Module::Package::Dist';
161		my $r = eval { $self->_load_plugin($spec, $namespace); };
162		return $r if ref $r;
163		return;
164		}
165
166		#-----------------------------------------------------------------------------#
167		# These are the user side analogs to the author side plugin API calls.
168		# Prefix with '_' to not pollute Module::Install plugin space.
169		#-----------------------------------------------------------------------------#
170		sub _initial {
171		my ($self) = @_;
172		}
173
174		sub _main {
175		my ($self) = @_;
176		}
177
178		# NOTE These must match Module::Package::Plugin::final.
179		sub _final {
180		my ($self) = @_;
181		$self->_all_from;
182		$self->_requires_from;
183		$self->_install_bin;
184		$self->_install_share;
185		$self->_WriteAll;
186		}
187
188		#-----------------------------------------------------------------------------#
189		# This section is where all the useful code bits go. These bits are needed by
190		# both Author and User side runs.
191		#-----------------------------------------------------------------------------#
192
193		my $all_from = 0;
194		sub _all_from {
195		my $self = shift;
196		return if $all_from++;
197		return if $self->name;
198		my $file = shift \|\| "$main::PM" or die "all_from has no file";
199		$self->all_from($file);
200		}
201
202		my $requires_from = 0;
203		sub _requires_from {
204		my $self = shift;
205		return if $requires_from++;
206		return unless $self->package_options->{requires_from};
207		my $file = shift \|\| "$main::PM" or die "requires_from has no file";
208		$self->requires_from($main::PM)
209		}
210
211		my $install_bin = 0;
212		sub _install_bin {
213		my $self = shift;
214		return if $install_bin++;
215		return unless $self->package_options->{install_bin};
216		return unless -d 'bin';
217		my @bin;
218		File::Find::find(sub {
219		return unless -f $_;
220		push @bin, $File::Find::name;
221		}, 'bin');
222		$self->install_script($_) for @bin;
223		}
224
225		my $install_share = 0;
226		sub _install_share {
227		my $self = shift;
228		return if $install_share++;
229		return unless $self->package_options->{install_share};
230		return unless -d 'share';
231		$self->install_share;
232		}
233
234		my $WriteAll = 0;
235		sub _WriteAll {
236		my $self = shift;
237		return if $WriteAll++;
238		$self->WriteAll(@_);
239		}
240
241		# Base package for Module::Package plugin distributed components.
242		package Module::Package::Dist;
243
244		sub new {
245		my ($class, %args) = @_;
246		bless \%args, $class;
247		}
248
249		sub mi {
250		@_ > 1 ? ($_[0]->{mi}=$_[1]) : $_[0]->{mi};
251		}
252
253		sub _initial {
254		my ($self) = @_;
255		}
256
257		sub _main {
258		my ($self) = @_;
259		}
260
261		sub _final {
262		my ($self) = @_;
263		}
264
265		1;
266
267		#-----------------------------------------------------------------------------#
268		# Take a guess at the primary .pm and .pod files for 'all_from', and friends.
269		# Put them in global magical vars in the main:: namespace.
270		#-----------------------------------------------------------------------------#
271		package Module::Package::PM;
272		use overload '""' => sub {
273		$_[0]->guess_pm unless @{$_[0]};
274		return $_[0]->[0];
275		};
276		sub set { $_[0]->[0] = $_[1] }
277		sub guess_pm {
278		my $pm = '';
279		my $self = shift;
280		if (-e 'META.yml') {
281		open META, 'META.yml' or die "Can't open 'META.yml' for input:\n$!";
282		my $meta = do { local $/; <META> };
283		close META;
284		$meta =~ /^module_name: (\S+)$/m
285		or die "Can't get module_name from META.yml";
286		$pm = $1;
287		$pm =~ s!::!/!g;
288		$pm = "lib/$pm.pm";
289		}
290		else {
291		require File::Find;
292		my @array = ();
293		File::Find::find(sub {
294		return unless /\.pm$/;
295		my $name = $File::Find::name;
296		my $num = ($name =~ s!/+!/!g);
297		my $ary = $array[$num] \|\|= [];
298		push @$ary, $name;
299		}, 'lib');
300		shift @array while @array and not defined $array[0];
301		die "Can't guess main module" unless @array;
302		(($pm) = sort @{$array[0]}) or
303		die "Can't guess main module";
304		}
305		my $pmc = $pm . 'c';
306		$pm = $pmc if -e $pmc;
307		$self->set($pm);
308		}
309		$main::PM = bless [$main::PM ? ($main::PM) : ()], __PACKAGE__;
310
311		package Module::Package::POD;
312		use overload '""' => sub {
313		return $_[0]->[0] if @{$_[0]};
314		(my $pod = "$main::PM") =~ s/\.pm/.pod/
315		or die "Module::Package's \$main::PM value should end in '.pm'";
316		return -e $pod ? $pod : '';
317		};
318		sub set { $_[0][0] = $_[1] }
319		$main::POD = bless [$main::POD ? ($main::POD) : ()], __PACKAGE__;
320
321		1;
322

-52

~~inc/Module/Install/TrustMetaYml.pm~~ less more

0		#line 1
1		package Module::Install::TrustMetaYml;
2
3		use 5.008;
4		use constant { FALSE => 0, TRUE => 1 };
5		use strict;
6		use utf8;
7
8		BEGIN {
9		$Module::Install::TrustMetaYml::AUTHORITY = 'cpan:TOBYINK';
10		}
11		BEGIN {
12		$Module::Install::TrustMetaYml::VERSION = '0.001';
13		}
14
15		use base qw(Module::Install::Base);
16
17		sub trust_meta_yml
18		{
19		my ($self, $where) = @_;
20		$where \|\|= 'META.yml';
21
22		$self->perl_version('5.006') unless defined $self->perl_version;
23
24		$self->include_deps('YAML::Tiny', 0);
25		return $self if $self->is_admin;
26
27		require YAML::Tiny;
28		my $data = YAML::Tiny::LoadFile($where);
29
30		$self->perl_version($data->{requires}{perl} \|\| '5.006');
31
32		KEY: foreach my $key (qw(requires recommends build_requires))
33		{
34		next KEY unless ref $data->{$key} eq 'HASH';
35		my %deps = %{$data->{$key}};
36		DEP: while (my ($pkg, $ver) = each %deps)
37		{
38		next if $pkg eq 'perl';
39		$self->$key($pkg, $ver);
40		}
41		}
42
43		return $self;
44		}
45
46		*trust_meta_yaml = \&trust_meta_yml;
47
48		TRUE;
49
50		__END__
51

-64

~~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 @ISA $ISCORE};
7		BEGIN {
8		$VERSION = '1.06';
9		@ISA = 'Module::Install::Base';
10		$ISCORE = 1;
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		die <<'END_MESSAGE' unless $rv;
41
42		-------------------------------------------------------------------------------
43
44		Since you are using Microsoft Windows, you will need the 'nmake' utility
45		before installation. It's available at:
46
47		http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
48		or
49		ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
50
51		Please download the file manually, save it to a directory in %PATH% (e.g.
52		C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
53		that directory, and run "Nmake15.exe" from there; that will create the
54		'nmake.exe' file needed by this module.
55
56		You may then resume the installation process described in README.
57
58		-------------------------------------------------------------------------------
59		END_MESSAGE
60
61		}
62
63		1;

-63

~~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 @ISA $ISCORE};
7		BEGIN {
8		$VERSION = '1.06';
9		@ISA = qw{Module::Install::Base};
10		$ISCORE = 1;
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->admin->WriteAll(%args) if $self->is_admin;
25
26		$self->check_nmake if $args{check_nmake};
27		unless ( $self->makemaker_args->{PL_FILES} ) {
28		# XXX: This still may be a bit over-defensive...
29		unless ($self->makemaker(6.25)) {
30		$self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
31		}
32		}
33
34		# Until ExtUtils::MakeMaker support MYMETA.yml, make sure
35		# we clean it up properly ourself.
36		$self->realclean_files('MYMETA.yml');
37
38		if ( $args{inline} ) {
39		$self->Inline->write;
40		} else {
41		$self->Makefile->write;
42		}
43
44		# The Makefile write process adds a couple of dependencies,
45		# so write the META.yml files after the Makefile.
46		if ( $args{meta} ) {
47		$self->Meta->write;
48		}
49
50		# Experimental support for MYMETA
51		if ( $ENV{X_MYMETA} ) {
52		if ( $ENV{X_MYMETA} eq 'JSON' ) {
53		$self->Meta->write_mymeta_json;
54		} else {
55		$self->Meta->write_mymeta_yaml;
56		}
57		}
58
59		return 1;
60		}
61
62		1;

-470

~~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.005;
20		use strict 'vars';
21		use Cwd ();
22		use File::Find ();
23		use File::Path ();
24
25		use vars qw{$VERSION $MAIN};
26		BEGIN {
27		# All Module::Install core packages now require synchronised versions.
28		# This will be used to ensure we don't accidentally load old or
29		# different versions of modules.
30		# This is not enforced yet, but will be some time in the next few
31		# releases once we can make sure it won't clash with custom
32		# Module::Install extensions.
33		$VERSION = '1.06';
34
35		# Storage for the pseudo-singleton
36		$MAIN = undef;
37
38		inc::Module::Install::VERSION = VERSION;
39		@inc::Module::Install::ISA = __PACKAGE__;
40
41		}
42
43		sub import {
44		my $class = shift;
45		my $self = $class->new(@_);
46		my $who = $self->_caller;
47
48		#-------------------------------------------------------------
49		# all of the following checks should be included in import(),
50		# to allow "eval 'require Module::Install; 1' to test
51		# installation of Module::Install. (RT #51267)
52		#-------------------------------------------------------------
53
54		# Whether or not inc::Module::Install is actually loaded, the
55		# $INC{inc/Module/Install.pm} is what will still get set as long as
56		# the caller loaded module this in the documented manner.
57		# If not set, the caller may NOT have loaded the bundled version, and thus
58		# they may not have a MI version that works with the Makefile.PL. This would
59		# result in false errors or unexpected behaviour. And we don't want that.
60		my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
61		unless ( $INC{$file} ) { die <<"END_DIE" }
62
63		Please invoke ${\__PACKAGE__} with:
64
65		use inc::${\__PACKAGE__};
66
67		not:
68
69		use ${\__PACKAGE__};
70
71		END_DIE
72
73		# This reportedly fixes a rare Win32 UTC file time issue, but
74		# as this is a non-cross-platform XS module not in the core,
75		# we shouldn't really depend on it. See RT #24194 for detail.
76		# (Also, this module only supports Perl 5.6 and above).
77		eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
78
79		# If the script that is loading Module::Install is from the future,
80		# then make will detect this and cause it to re-run over and over
81		# again. This is bad. Rather than taking action to touch it (which
82		# is unreliable on some platforms and requires write permissions)
83		# for now we should catch this and refuse to run.
84		if ( -f $0 ) {
85		my $s = (stat($0))[9];
86
87		# If the modification time is only slightly in the future,
88		# sleep briefly to remove the problem.
89		my $a = $s - time;
90		if ( $a > 0 and $a < 5 ) { sleep 5 }
91
92		# Too far in the future, throw an error.
93		my $t = time;
94		if ( $s > $t ) { die <<"END_DIE" }
95
96		Your installer $0 has a modification time in the future ($s > $t).
97
98		This is known to create infinite loops in make.
99
100		Please correct this, then run $0 again.
101
102		END_DIE
103		}
104
105
106		# Build.PL was formerly supported, but no longer is due to excessive
107		# difficulty in implementing every single feature twice.
108		if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
109
110		Module::Install no longer supports Build.PL.
111
112		It was impossible to maintain duel backends, and has been deprecated.
113
114		Please remove all Build.PL files and only use the Makefile.PL installer.
115
116		END_DIE
117
118		#-------------------------------------------------------------
119
120		# To save some more typing in Module::Install installers, every...
121		# use inc::Module::Install
122		# ...also acts as an implicit use strict.
123		$^H \|= strict::bits(qw(refs subs vars));
124
125		#-------------------------------------------------------------
126
127		unless ( -f $self->{file} ) {
128		foreach my $key (keys %INC) {
129		delete $INC{$key} if $key =~ /Module\/Install/;
130		}
131
132		local $^W;
133		require "$self->{path}/$self->{dispatch}.pm";
134		File::Path::mkpath("$self->{prefix}/$self->{author}");
135		$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
136		$self->{admin}->init;
137		@_ = ($class, _self => $self);
138		goto &{"$self->{name}::import"};
139		}
140
141		local $^W;
142		*{"${who}::AUTOLOAD"} = $self->autoload;
143		$self->preload;
144
145		# Unregister loader and worker packages so subdirs can use them again
146		delete $INC{'inc/Module/Install.pm'};
147		delete $INC{'Module/Install.pm'};
148
149		# Save to the singleton
150		$MAIN = $self;
151
152		return 1;
153		}
154
155		sub autoload {
156		my $self = shift;
157		my $who = $self->_caller;
158		my $cwd = Cwd::cwd();
159		my $sym = "${who}::AUTOLOAD";
160		$sym->{$cwd} = sub {
161		my $pwd = Cwd::cwd();
162		if ( my $code = $sym->{$pwd} ) {
163		# Delegate back to parent dirs
164		goto &$code unless $cwd eq $pwd;
165		}
166		unless ($$sym =~ s/([^:]+)$//) {
167		# XXX: it looks like we can't retrieve the missing function
168		# via $$sym (usually $main::AUTOLOAD) in this case.
169		# I'm still wondering if we should slurp Makefile.PL to
170		# get some context or not ...
171		my ($package, $file, $line) = caller;
172		die <<"EOT";
173		Unknown function is found at $file line $line.
174		Execution of $file aborted due to runtime errors.
175
176		If you're a contributor to a project, you may need to install
177		some Module::Install extensions from CPAN (or other repository).
178		If you're a user of a module, please contact the author.
179		EOT
180		}
181		my $method = $1;
182		if ( uc($method) eq $method ) {
183		# Do nothing
184		return;
185		} elsif ( $method =~ /^_/ and $self->can($method) ) {
186		# Dispatch to the root M:I class
187		return $self->$method(@_);
188		}
189
190		# Dispatch to the appropriate plugin
191		unshift @_, ( $self, $1 );
192		goto &{$self->can('call')};
193		};
194		}
195
196		sub preload {
197		my $self = shift;
198		unless ( $self->{extensions} ) {
199		$self->load_extensions(
200		"$self->{prefix}/$self->{path}", $self
201		);
202		}
203
204		my @exts = @{$self->{extensions}};
205		unless ( @exts ) {
206		@exts = $self->{admin}->load_all_extensions;
207		}
208
209		my %seen;
210		foreach my $obj ( @exts ) {
211		while (my ($method, $glob) = each %{ref($obj) . '::'}) {
212		next unless $obj->can($method);
213		next if $method =~ /^_/;
214		next if $method eq uc($method);
215		$seen{$method}++;
216		}
217		}
218
219		my $who = $self->_caller;
220		foreach my $name ( sort keys %seen ) {
221		local $^W;
222		*{"${who}::$name"} = sub {
223		${"${who}::AUTOLOAD"} = "${who}::$name";
224		goto &{"${who}::AUTOLOAD"};
225		};
226		}
227		}
228
229		sub new {
230		my ($class, %args) = @_;
231
232		delete $INC{'FindBin.pm'};
233		{
234		# to suppress the redefine warning
235		local $SIG{__WARN__} = sub {};
236		require FindBin;
237		}
238
239		# ignore the prefix on extension modules built from top level.
240		my $base_path = Cwd::abs_path($FindBin::Bin);
241		unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
242		delete $args{prefix};
243		}
244		return $args{_self} if $args{_self};
245
246		$args{dispatch} \|\|= 'Admin';
247		$args{prefix} \|\|= 'inc';
248		$args{author} \|\|= ($^O eq 'VMS' ? '_author' : '.author');
249		$args{bundle} \|\|= 'inc/BUNDLES';
250		$args{base} \|\|= $base_path;
251		$class =~ s/^\Q$args{prefix}\E:://;
252		$args{name} \|\|= $class;
253		$args{version} \|\|= $class->VERSION;
254		unless ( $args{path} ) {
255		$args{path} = $args{name};
256		$args{path} =~ s!::!/!g;
257		}
258		$args{file} \|\|= "$args{base}/$args{prefix}/$args{path}.pm";
259		$args{wrote} = 0;
260
261		bless( \%args, $class );
262		}
263
264		sub call {
265		my ($self, $method) = @_;
266		my $obj = $self->load($method) or return;
267		splice(@_, 0, 2, $obj);
268		goto &{$obj->can($method)};
269		}
270
271		sub load {
272		my ($self, $method) = @_;
273
274		$self->load_extensions(
275		"$self->{prefix}/$self->{path}", $self
276		) unless $self->{extensions};
277
278		foreach my $obj (@{$self->{extensions}}) {
279		return $obj if $obj->can($method);
280		}
281
282		my $admin = $self->{admin} or die <<"END_DIE";
283		The '$method' method does not exist in the '$self->{prefix}' path!
284		Please remove the '$self->{prefix}' directory and run $0 again to load it.
285		END_DIE
286
287		my $obj = $admin->load($method, 1);
288		push @{$self->{extensions}}, $obj;
289
290		$obj;
291		}
292
293		sub load_extensions {
294		my ($self, $path, $top) = @_;
295
296		my $should_reload = 0;
297		unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
298		unshift @INC, $self->{prefix};
299		$should_reload = 1;
300		}
301
302		foreach my $rv ( $self->find_extensions($path) ) {
303		my ($file, $pkg) = @{$rv};
304		next if $self->{pathnames}{$pkg};
305
306		local $@;
307		my $new = eval { local $^W; require $file; $pkg->can('new') };
308		unless ( $new ) {
309		warn $@ if $@;
310		next;
311		}
312		$self->{pathnames}{$pkg} =
313		$should_reload ? delete $INC{$file} : $INC{$file};
314		push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
315		}
316
317		$self->{extensions} \|\|= [];
318		}
319
320		sub find_extensions {
321		my ($self, $path) = @_;
322
323		my @found;
324		File::Find::find( sub {
325		my $file = $File::Find::name;
326		return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
327		my $subpath = $1;
328		return if lc($subpath) eq lc($self->{dispatch});
329
330		$file = "$self->{path}/$subpath.pm";
331		my $pkg = "$self->{name}::$subpath";
332		$pkg =~ s!/!::!g;
333
334		# If we have a mixed-case package name, assume case has been preserved
335		# correctly. Otherwise, root through the file to locate the case-preserved
336		# version of the package name.
337		if ( $subpath eq lc($subpath) \|\| $subpath eq uc($subpath) ) {
338		my $content = Module::Install::_read($subpath . '.pm');
339		my $in_pod = 0;
340		foreach ( split //, $content ) {
341		$in_pod = 1 if /^=\w/;
342		$in_pod = 0 if /^=cut/;
343		next if ($in_pod \|\| /^=cut/); # skip pod text
344		next if /^\s*#/; # and comments
345		if ( m/^\spackage\s+($pkg)\s;/i ) {
346		$pkg = $1;
347		last;
348		}
349		}
350		}
351
352		push @found, [ $file, $pkg ];
353		}, $path ) if -d $path;
354
355		@found;
356		}
357
358
359
360
361
362		#####################################################################
363		# Common Utility Functions
364
365		sub _caller {
366		my $depth = 0;
367		my $call = caller($depth);
368		while ( $call eq __PACKAGE__ ) {
369		$depth++;
370		$call = caller($depth);
371		}
372		return $call;
373		}
374
375		# Done in evals to avoid confusing Perl::MinimumVersion
376		eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
377		sub _read {
378		local *FH;
379		open( FH, '<', $_[0] ) or die "open($_[0]): $!";
380		my $string = do { local $/; <FH> };
381		close FH or die "close($_[0]): $!";
382		return $string;
383		}
384		END_NEW
385		sub _read {
386		local *FH;
387		open( FH, "< $_[0]" ) or die "open($_[0]): $!";
388		my $string = do { local $/; <FH> };
389		close FH or die "close($_[0]): $!";
390		return $string;
391		}
392		END_OLD
393
394		sub _readperl {
395		my $string = Module::Install::_read($_[0]);
396		$string =~ s/(?:\015{1,2}\012\|\015\|\012)/\n/sg;
397		$string =~ s/(\n)\n__(?:DATA\|END)__\b.\z/$1/s;
398		$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
399		return $string;
400		}
401
402		sub _readpod {
403		my $string = Module::Install::_read($_[0]);
404		$string =~ s/(?:\015{1,2}\012\|\015\|\012)/\n/sg;
405		return $string if $_[0] =~ /\.pod\z/;
406		$string =~ s/(^\|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+\|\z)/$1$2/sg;
407		$string =~ s/\n=pod\b[^\n]\n+/\n\n/sg;
408		$string =~ s/\n=cut\b[^\n]\n+/\n\n/sg;
409		$string =~ s/^\n+//s;
410		return $string;
411		}
412
413		# Done in evals to avoid confusing Perl::MinimumVersion
414		eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
415		sub _write {
416		local *FH;
417		open( FH, '>', $_[0] ) or die "open($_[0]): $!";
418		foreach ( 1 .. $#_ ) {
419		print FH $_[$_] or die "print($_[0]): $!";
420		}
421		close FH or die "close($_[0]): $!";
422		}
423		END_NEW
424		sub _write {
425		local *FH;
426		open( FH, "> $_[0]" ) or die "open($_[0]): $!";
427		foreach ( 1 .. $#_ ) {
428		print FH $_[$_] or die "print($_[0]): $!";
429		}
430		close FH or die "close($_[0]): $!";
431		}
432		END_OLD
433
434		# _version is for processing module versions (eg, 1.03_05) not
435		# Perl versions (eg, 5.8.1).
436		sub _version ($) {
437		my $s = shift \|\| 0;
438		my $d =()= $s =~ /(\.)/g;
439		if ( $d >= 2 ) {
440		# Normalise multipart versions
441		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
442		}
443		$s =~ s/^(\d+)\.?//;
444		my $l = $1 \|\| 0;
445		my @v = map {
446		$_ . '0' x (3 - length $_)
447		} $s =~ /(\d{1,3})\D?/g;
448		$l = $l . '.' . join '', @v if @v;
449		return $l + 0;
450		}
451
452		sub _cmp ($$) {
453		_version($_[1]) <=> _version($_[2]);
454		}
455
456		# Cloned from Params::Util::_CLASS
457		sub _CLASS ($) {
458		(
459		defined $_[0]
460		and
461		! ref $_[0]
462		and
463		$_[0] =~ m/^[^\W\d]\w(?:::\w+)\z/s
464		) ? $_[0] : undef;
465		}
466
467		1;
468
469		# Copyright 2008 - 2012 Adam Kennedy.

-27

~~inc/Module/Package/Dist/RDF.pm~~ less more

0		#line 1
1		package Module::Package::Dist::RDF;
2
3		use 5.008003;
4		BEGIN {
5		$Module::Package::Dist::RDF::AUTHORITY = 'cpan:TOBYINK';
6		$Module::Package::Dist::RDF::VERSION = '0.005';
7		}
8
9		package Module::Package::Dist::RDF::standard;
10
11		use 5.008003;
12		use strict;
13		use base qw[Module::Package::Dist];
14		BEGIN {
15		$Module::Package::Dist::RDF::standard::AUTHORITY = 'cpan:TOBYINK';
16		$Module::Package::Dist::RDF::standard::VERSION = '0.005';
17		}
18
19		sub _main
20		{
21		my ($self) = @_;
22		$self->mi->trust_meta_yml;
23		$self->mi->auto_install;
24		}
25
26		1;

-71

~~inc/Module/Package.pm~~ less more

0		#line 1
1		##
2		# name: Module::Package
3		# abstract: Postmodern Perl Module Packaging
4		# author: Ingy döt Net <ingy@cpan.org>
5		# license: perl
6		# copyright: 2011
7		# see:
8		# - Module::Package::Plugin
9		# - Module::Install::Package
10		# - Module::Package::Tutorial
11
12		package Module::Package;
13		use 5.005;
14		use strict;
15
16		BEGIN {
17		$Module::Package::VERSION = '0.30';
18		$inc::Module::Package::VERSION \|\|= $Module::Package::VERSION;
19		@inc::Module::Package::ISA = __PACKAGE__;
20		}
21
22		sub import {
23		my $class = shift;
24		$INC{'inc/Module/Install.pm'} = __FILE__;
25		unshift @INC, 'inc' unless $INC[0] eq 'inc';
26		eval "use Module::Install 1.01 (); 1" or $class->error($@);
27
28		package main;
29		Module::Install->import();
30		eval {
31		module_package_internals_version_check($Module::Package::VERSION);
32		module_package_internals_init(@_);
33		};
34		if ($@) {
35		$Module::Package::ERROR = $@;
36		die $@;
37		}
38		}
39
40		# XXX Remove this when things are stable.
41		sub error {
42		my ($class, $error) = @_;
43		if (-e 'inc' and not -e 'inc/.author') {
44		require Data::Dumper;
45		$Data::Dumper::Sortkeys = 1;
46		my $dump1 = Data::Dumper::Dumper(\%INC);
47		my $dump2 = Data::Dumper::Dumper(\@INC);
48		die <<"...";
49		This should not have happened. Hopefully this dump will explain the problem:
50
51		inc::Module::Package: $inc::Module::Package::VERSION
52		Module::Package: $Module::Package::VERSION
53		inc::Module::Install: $inc::Module::Install::VERSION
54		Module::Install: $Module::Install::VERSION
55
56		Error: $error
57
58		%INC:
59		$dump1
60		\@INC:
61		$dump2
62		...
63		}
64		else {
65		die $error;
66		}
67		}
68
69		1;
70

-109

~~inc/Scalar/Util/PP.pm~~ less more

0		#line 1
1		# Scalar::Util::PP.pm
2		#
3		# Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved.
4		# This program is free software; you can redistribute it and/or
5		# modify it under the same terms as Perl itself.
6		#
7		# This module is normally only loaded if the XS module is not available
8
9		package Scalar::Util::PP;
10
11		use strict;
12		use warnings;
13		use vars qw(@ISA @EXPORT $VERSION $recurse);
14		require Exporter;
15		use B qw(svref_2object);
16
17		@ISA = qw(Exporter);
18		@EXPORT = qw(blessed reftype tainted readonly refaddr looks_like_number);
19		$VERSION = "1.23";
20		$VERSION = eval $VERSION;
21
22		sub blessed ($) {
23		return undef unless length(ref($_[0]));
24		my $b = svref_2object($_[0]);
25		return undef unless $b->isa('B::PVMG');
26		my $s = $b->SvSTASH;
27		return $s->isa('B::HV') ? $s->NAME : undef;
28		}
29
30		sub refaddr($) {
31		return undef unless length(ref($_[0]));
32
33		my $addr;
34		if(defined(my $pkg = blessed($_[0]))) {
35		$addr .= bless $_[0], 'Scalar::Util::Fake';
36		bless $_[0], $pkg;
37		}
38		else {
39		$addr .= $_[0]
40		}
41
42		$addr =~ /0x(\w+)/;
43		local $^W;
44		no warnings 'portable';
45		hex($1);
46		}
47
48		{
49		my %tmap = qw(
50		B::NULL SCALAR
51
52		B::HV HASH
53		B::AV ARRAY
54		B::CV CODE
55		B::IO IO
56		B::GV GLOB
57		B::REGEXP REGEXP
58		);
59
60		sub reftype ($) {
61		my $r = shift;
62
63		return undef unless length(ref($r));
64
65		my $t = ref(svref_2object($r));
66
67		return
68		exists $tmap{$t} ? $tmap{$t}
69		: length(ref($$r)) ? 'REF'
70		: 'SCALAR';
71		}
72		}
73
74		sub tainted {
75		local($@, $SIG{__DIE__}, $SIG{__WARN__});
76		local $^W = 0;
77		no warnings;
78		eval { kill 0 * $_[0] };
79		$@ =~ /^Insecure/;
80		}
81
82		sub readonly {
83		return 0 if tied($_[0]) \|\| (ref(\($_[0])) ne "SCALAR");
84
85		local($@, $SIG{__DIE__}, $SIG{__WARN__});
86		my $tmp = $_[0];
87
88		!eval { $_[0] = $tmp; 1 };
89		}
90
91		sub looks_like_number {
92		local $_ = shift;
93
94		# checks from perlfaq4
95		return 0 if !defined($_);
96		if (ref($_)) {
97		require overload;
98		return overload::Overloaded($_) ? defined(0 + $_) : 0;
99		}
100		return 1 if (/^[+-]?[0-9]+$/); # is a +/- integer
101		return 1 if (/^([+-]?)(?=[0-9]\|\.[0-9])[0-9](\.[0-9])?([Ee]([+-]?[0-9]+))?$/); # a C float
102		return 1 if ($] >= 5.008 and /^(Inf(inity)?\|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
103
104		0;
105		}
106
107
108		1;

-71

~~inc/Scalar/Util.pm~~ less more

0		#line 1
1		# Scalar::Util.pm
2		#
3		# Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
4		# This program is free software; you can redistribute it and/or
5		# modify it under the same terms as Perl itself.
6
7		package Scalar::Util;
8
9		use strict;
10		use vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL);
11		require Exporter;
12		require List::Util; # List::Util loads the XS
13
14		@ISA = qw(Exporter);
15		@EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
16		$VERSION = "1.23";
17		$VERSION = eval $VERSION;
18
19		unless (defined &dualvar) {
20		# Load Pure Perl version if XS not loaded
21		require Scalar::Util::PP;
22		Scalar::Util::PP->import;
23		push @EXPORT_FAIL, qw(weaken isweak dualvar isvstring set_prototype);
24		}
25
26		sub export_fail {
27		if (grep { /dualvar/ } @EXPORT_FAIL) { # no XS loaded
28		my $pat = join("\|", @EXPORT_FAIL);
29		if (my ($err) = grep { /^($pat)$/ } @_ ) {
30		require Carp;
31		Carp::croak("$err is only available with the XS version of Scalar::Util");
32		}
33		}
34
35		if (grep { /^(weaken\|isweak)$/ } @_ ) {
36		require Carp;
37		Carp::croak("Weak references are not implemented in the version of perl");
38		}
39
40		if (grep { /^(isvstring)$/ } @_ ) {
41		require Carp;
42		Carp::croak("Vstrings are not implemented in the version of perl");
43		}
44
45		@_;
46		}
47
48		sub openhandle ($) {
49		my $fh = shift;
50		my $rt = reftype($fh) \|\| '';
51
52		return defined(fileno($fh)) ? $fh : undef
53		if $rt eq 'IO';
54
55		if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA)
56		$fh = \(my $tmp=$fh);
57		}
58		elsif ($rt ne 'GLOB') {
59		return undef;
60		}
61
62		(tied(*$fh) or defined(fileno($fh)))
63		? $fh : undef;
64		}
65
66		1;
67
68		__END__
69
70		#line 283

-643

~~inc/YAML/Tiny.pm~~ less more

0		#line 1
1		package YAML::Tiny;
2
3		use strict;
4
5		# UTF Support?
6		sub HAVE_UTF8 () { $] >= 5.007003 }
7		BEGIN {
8		if ( HAVE_UTF8 ) {
9		# The string eval helps hide this from Test::MinimumVersion
10		eval "require utf8;";
11		die "Failed to load UTF-8 support" if $@;
12		}
13
14		# Class structure
15		require 5.004;
16		require Exporter;
17		require Carp;
18		$YAML::Tiny::VERSION = '1.51';
19		# $YAML::Tiny::VERSION = eval $YAML::Tiny::VERSION;
20		@YAML::Tiny::ISA = qw{ Exporter };
21		@YAML::Tiny::EXPORT = qw{ Load Dump };
22		@YAML::Tiny::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
23
24		# Error storage
25		$YAML::Tiny::errstr = '';
26		}
27
28		# The character class of all characters we need to escape
29		# NOTE: Inlined, since it's only used once
30		# my $RE_ESCAPE = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]';
31
32		# Printed form of the unprintable characters in the lowest range
33		# of ASCII characters, listed by ASCII ordinal position.
34		my @UNPRINTABLE = qw(
35		z x01 x02 x03 x04 x05 x06 a
36		x08 t n v f r x0e x0f
37		x10 x11 x12 x13 x14 x15 x16 x17
38		x18 x19 x1a e x1c x1d x1e x1f
39		);
40
41		# Printable characters for escapes
42		my %UNESCAPES = (
43		z => "\x00", a => "\x07", t => "\x09",
44		n => "\x0a", v => "\x0b", f => "\x0c",
45		r => "\x0d", e => "\x1b", '\\' => '\\',
46		);
47
48		# Special magic boolean words
49		my %QUOTE = map { $_ => 1 } qw{
50		null Null NULL
51		y Y yes Yes YES n N no No NO
52		true True TRUE false False FALSE
53		on On ON off Off OFF
54		};
55
56
57
58
59
60		#####################################################################
61		# Implementation
62
63		# Create an empty YAML::Tiny object
64		sub new {
65		my $class = shift;
66		bless [ @_ ], $class;
67		}
68
69		# Create an object from a file
70		sub read {
71		my $class = ref $_[0] ? ref shift : shift;
72
73		# Check the file
74		my $file = shift or return $class->_error( 'You did not specify a file name' );
75		return $class->_error( "File '$file' does not exist" ) unless -e $file;
76		return $class->_error( "'$file' is a directory, not a file" ) unless -f _;
77		return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
78
79		# Slurp in the file
80		local $/ = undef;
81		local *CFG;
82		unless ( open(CFG, $file) ) {
83		return $class->_error("Failed to open file '$file': $!");
84		}
85		my $contents = <CFG>;
86		unless ( close(CFG) ) {
87		return $class->_error("Failed to close file '$file': $!");
88		}
89
90		$class->read_string( $contents );
91		}
92
93		# Create an object from a string
94		sub read_string {
95		my $class = ref $_[0] ? ref shift : shift;
96		my $self = bless [], $class;
97		my $string = $_[0];
98		eval {
99		unless ( defined $string ) {
100		die \"Did not provide a string to load";
101		}
102
103		# Byte order marks
104		# NOTE: Keeping this here to educate maintainers
105		# my %BOM = (
106		# "\357\273\277" => 'UTF-8',
107		# "\376\377" => 'UTF-16BE',
108		# "\377\376" => 'UTF-16LE',
109		# "\377\376\0\0" => 'UTF-32LE'
110		# "\0\0\376\377" => 'UTF-32BE',
111		# );
112		if ( $string =~ /^(?:\376\377\|\377\376\|\377\376\0\0\|\0\0\376\377)/ ) {
113		die \"Stream has a non UTF-8 BOM";
114		} else {
115		# Strip UTF-8 bom if found, we'll just ignore it
116		$string =~ s/^\357\273\277//;
117		}
118
119		# Try to decode as utf8
120		utf8::decode($string) if HAVE_UTF8;
121
122		# Check for some special cases
123		return $self unless length $string;
124		unless ( $string =~ /[\012\015]+\z/ ) {
125		die \"Stream does not end with newline character";
126		}
127
128		# Split the file into lines
129		my @lines = grep { ! /^\s(?:\#.)?\z/ }
130		split /(?:\015{1,2}\012\|\015\|\012)/, $string;
131
132		# Strip the initial YAML header
133		@lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
134
135		# A nibbling parser
136		while ( @lines ) {
137		# Do we have a document header?
138		if ( $lines[0] =~ /^---\s(?:(.+)\s)?\z/ ) {
139		# Handle scalar documents
140		shift @lines;
141		if ( defined $1 and $1 !~ /^(?:\#.+\|\%YAML[: ][\d\.]+)\z/ ) {
142		push @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
143		next;
144		}
145		}
146
147		if ( ! @lines or $lines[0] =~ /^(?:---\|\.\.\.)/ ) {
148		# A naked document
149		push @$self, undef;
150		while ( @lines and $lines[0] !~ /^---/ ) {
151		shift @lines;
152		}
153
154		} elsif ( $lines[0] =~ /^\s*\-/ ) {
155		# An array at the root
156		my $document = [ ];
157		push @$self, $document;
158		$self->_read_array( $document, [ 0 ], \@lines );
159
160		} elsif ( $lines[0] =~ /^(\s*)\S/ ) {
161		# A hash at the root
162		my $document = { };
163		push @$self, $document;
164		$self->_read_hash( $document, [ length($1) ], \@lines );
165
166		} else {
167		die \"YAML::Tiny failed to classify the line '$lines[0]'";
168		}
169		}
170		};
171		if ( ref $@ eq 'SCALAR' ) {
172		return $self->_error(${$@});
173		} elsif ( $@ ) {
174		require Carp;
175		Carp::croak($@);
176		}
177
178		return $self;
179		}
180
181		# Deparse a scalar string to the actual scalar
182		sub _read_scalar {
183		my ($self, $string, $indent, $lines) = @_;
184
185		# Trim trailing whitespace
186		$string =~ s/\s*\z//;
187
188		# Explitic null/undef
189		return undef if $string eq '~';
190
191		# Single quote
192		if ( $string =~ /^\'(.?)\'(?:\s+\#.)?\z/ ) {
193		return '' unless defined $1;
194		$string = $1;
195		$string =~ s/\'\'/\'/g;
196		return $string;
197		}
198
199		# Double quote.
200		# The commented out form is simpler, but overloaded the Perl regex
201		# engine due to recursion and backtracking problems on strings
202		# larger than 32,000ish characters. Keep it for reference purposes.
203		# if ( $string =~ /^\"((?:\\.\|[^\"])*)\"\z/ ) {
204		if ( $string =~ /^\"([^\\"](?:\\.[^\\"]))\"(?:\s+\#.)?\z/ ) {
205		# Reusing the variable is a little ugly,
206		# but avoids a new variable and a string copy.
207		$string = $1;
208		$string =~ s/\\"/"/g;
209		$string =~ s/\\([never\\fartz]\|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
210		return $string;
211		}
212
213		# Special cases
214		if ( $string =~ /^[\'\"!&]/ ) {
215		die \"YAML::Tiny does not support a feature in line '$string'";
216		}
217		return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
218		return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
219
220		# Regular unquoted string
221		if ( $string !~ /^[>\|]/ ) {
222		if (
223		$string =~ /^(?:-(?:\s\|$)\|[\@\%\`])/
224		or
225		$string =~ /:(?:\s\|$)/
226		) {
227		die \"YAML::Tiny found illegal characters in plain scalar: '$string'";
228		}
229		$string =~ s/\s+#.*\z//;
230		return $string;
231		}
232
233		# Error
234		die \"YAML::Tiny failed to find multi-line scalar content" unless @$lines;
235
236		# Check the indent depth
237		$lines->[0] =~ /^(\s*)/;
238		$indent->[-1] = length("$1");
239		if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
240		die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
241		}
242
243		# Pull the lines
244		my @multiline = ();
245		while ( @$lines ) {
246		$lines->[0] =~ /^(\s*)/;
247		last unless length($1) >= $indent->[-1];
248		push @multiline, substr(shift(@$lines), length($1));
249		}
250
251		my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
252		my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
253		return join( $j, @multiline ) . $t;
254		}
255
256		# Parse an array
257		sub _read_array {
258		my ($self, $array, $indent, $lines) = @_;
259
260		while ( @$lines ) {
261		# Check for a new document
262		if ( $lines->[0] =~ /^(?:---\|\.\.\.)/ ) {
263		while ( @$lines and $lines->[0] !~ /^---/ ) {
264		shift @$lines;
265		}
266		return 1;
267		}
268
269		# Check the indent level
270		$lines->[0] =~ /^(\s*)/;
271		if ( length($1) < $indent->[-1] ) {
272		return 1;
273		} elsif ( length($1) > $indent->[-1] ) {
274		die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
275		}
276
277		if ( $lines->[0] =~ /^(\s\-\s+)[^\'\"]\S\s*:(?:\s+\|$)/ ) {
278		# Inline nested hash
279		my $indent2 = length("$1");
280		$lines->[0] =~ s/-/ /;
281		push @$array, { };
282		$self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
283
284		} elsif ( $lines->[0] =~ /^\s\-(\s)(.+?)\s*\z/ ) {
285		# Array entry with a value
286		shift @$lines;
287		push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines );
288
289		} elsif ( $lines->[0] =~ /^\s\-\s\z/ ) {
290		shift @$lines;
291		unless ( @$lines ) {
292		push @$array, undef;
293		return 1;
294		}
295		if ( $lines->[0] =~ /^(\s*)\-/ ) {
296		my $indent2 = length("$1");
297		if ( $indent->[-1] == $indent2 ) {
298		# Null array entry
299		push @$array, undef;
300		} else {
301		# Naked indenter
302		push @$array, [ ];
303		$self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
304		}
305
306		} elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
307		push @$array, { };
308		$self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
309
310		} else {
311		die \"YAML::Tiny failed to classify line '$lines->[0]'";
312		}
313
314		} elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
315		# This is probably a structure like the following...
316		# ---
317		# foo:
318		# - list
319		# bar: value
320		#
321		# ... so lets return and let the hash parser handle it
322		return 1;
323
324		} else {
325		die \"YAML::Tiny failed to classify line '$lines->[0]'";
326		}
327		}
328
329		return 1;
330		}
331
332		# Parse an array
333		sub _read_hash {
334		my ($self, $hash, $indent, $lines) = @_;
335
336		while ( @$lines ) {
337		# Check for a new document
338		if ( $lines->[0] =~ /^(?:---\|\.\.\.)/ ) {
339		while ( @$lines and $lines->[0] !~ /^---/ ) {
340		shift @$lines;
341		}
342		return 1;
343		}
344
345		# Check the indent level
346		$lines->[0] =~ /^(\s*)/;
347		if ( length($1) < $indent->[-1] ) {
348		return 1;
349		} elsif ( length($1) > $indent->[-1] ) {
350		die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
351		}
352
353		# Get the key
354		unless ( $lines->[0] =~ s/^\s([^\'\" ][^\n]?)\s:(\s+(?:\#.)?\|$)// ) {
355		if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
356		die \"YAML::Tiny does not support a feature in line '$lines->[0]'";
357		}
358		die \"YAML::Tiny failed to classify line '$lines->[0]'";
359		}
360		my $key = $1;
361
362		# Do we have a value?
363		if ( length $lines->[0] ) {
364		# Yes
365		$hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
366		} else {
367		# An indent
368		shift @$lines;
369		unless ( @$lines ) {
370		$hash->{$key} = undef;
371		return 1;
372		}
373		if ( $lines->[0] =~ /^(\s*)-/ ) {
374		$hash->{$key} = [];
375		$self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
376		} elsif ( $lines->[0] =~ /^(\s*)./ ) {
377		my $indent2 = length("$1");
378		if ( $indent->[-1] >= $indent2 ) {
379		# Null hash entry
380		$hash->{$key} = undef;
381		} else {
382		$hash->{$key} = {};
383		$self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
384		}
385		}
386		}
387		}
388
389		return 1;
390		}
391
392		# Save an object to a file
393		sub write {
394		my $self = shift;
395		my $file = shift or return $self->_error('No file name provided');
396
397		# Write it to the file
398		open( CFG, '>' . $file ) or return $self->_error(
399		"Failed to open file '$file' for writing: $!"
400		);
401		print CFG $self->write_string;
402		close CFG;
403
404		return 1;
405		}
406
407		# Save an object to a string
408		sub write_string {
409		my $self = shift;
410		return '' unless @$self;
411
412		# Iterate over the documents
413		my $indent = 0;
414		my @lines = ();
415		foreach my $cursor ( @$self ) {
416		push @lines, '---';
417
418		# An empty document
419		if ( ! defined $cursor ) {
420		# Do nothing
421
422		# A scalar document
423		} elsif ( ! ref $cursor ) {
424		$lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent );
425
426		# A list at the root
427		} elsif ( ref $cursor eq 'ARRAY' ) {
428		unless ( @$cursor ) {
429		$lines[-1] .= ' []';
430		next;
431		}
432		push @lines, $self->_write_array( $cursor, $indent, {} );
433
434		# A hash at the root
435		} elsif ( ref $cursor eq 'HASH' ) {
436		unless ( %$cursor ) {
437		$lines[-1] .= ' {}';
438		next;
439		}
440		push @lines, $self->_write_hash( $cursor, $indent, {} );
441
442		} else {
443		Carp::croak("Cannot serialize " . ref($cursor));
444		}
445		}
446
447		join '', map { "$_\n" } @lines;
448		}
449
450		sub _write_scalar {
451		my $string = $_[1];
452		return '~' unless defined $string;
453		return "''" unless length $string;
454		if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) {
455		$string =~ s/\\/\\\\/g;
456		$string =~ s/"/\\"/g;
457		$string =~ s/\n/\\n/g;
458		$string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
459		return qq\|"$string"\|;
460		}
461		if ( $string =~ /(?:^\W\|\s\|:\z)/ or $QUOTE{$string} ) {
462		return "'$string'";
463		}
464		return $string;
465		}
466
467		sub _write_array {
468		my ($self, $array, $indent, $seen) = @_;
469		if ( $seen->{refaddr($array)}++ ) {
470		die "YAML::Tiny does not support circular references";
471		}
472		my @lines = ();
473		foreach my $el ( @$array ) {
474		my $line = (' ' x $indent) . '-';
475		my $type = ref $el;
476		if ( ! $type ) {
477		$line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
478		push @lines, $line;
479
480		} elsif ( $type eq 'ARRAY' ) {
481		if ( @$el ) {
482		push @lines, $line;
483		push @lines, $self->_write_array( $el, $indent + 1, $seen );
484		} else {
485		$line .= ' []';
486		push @lines, $line;
487		}
488
489		} elsif ( $type eq 'HASH' ) {
490		if ( keys %$el ) {
491		push @lines, $line;
492		push @lines, $self->_write_hash( $el, $indent + 1, $seen );
493		} else {
494		$line .= ' {}';
495		push @lines, $line;
496		}
497
498		} else {
499		die "YAML::Tiny does not support $type references";
500		}
501		}
502
503		@lines;
504		}
505
506		sub _write_hash {
507		my ($self, $hash, $indent, $seen) = @_;
508		if ( $seen->{refaddr($hash)}++ ) {
509		die "YAML::Tiny does not support circular references";
510		}
511		my @lines = ();
512		foreach my $name ( sort keys %$hash ) {
513		my $el = $hash->{$name};
514		my $line = (' ' x $indent) . "$name:";
515		my $type = ref $el;
516		if ( ! $type ) {
517		$line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
518		push @lines, $line;
519
520		} elsif ( $type eq 'ARRAY' ) {
521		if ( @$el ) {
522		push @lines, $line;
523		push @lines, $self->_write_array( $el, $indent + 1, $seen );
524		} else {
525		$line .= ' []';
526		push @lines, $line;
527		}
528
529		} elsif ( $type eq 'HASH' ) {
530		if ( keys %$el ) {
531		push @lines, $line;
532		push @lines, $self->_write_hash( $el, $indent + 1, $seen );
533		} else {
534		$line .= ' {}';
535		push @lines, $line;
536		}
537
538		} else {
539		die "YAML::Tiny does not support $type references";
540		}
541		}
542
543		@lines;
544		}
545
546		# Set error
547		sub _error {
548		$YAML::Tiny::errstr = $_[1];
549		undef;
550		}
551
552		# Retrieve error
553		sub errstr {
554		$YAML::Tiny::errstr;
555		}
556
557
558
559
560
561		#####################################################################
562		# YAML Compatibility
563
564		sub Dump {
565		YAML::Tiny->new(@_)->write_string;
566		}
567
568		sub Load {
569		my $self = YAML::Tiny->read_string(@_);
570		unless ( $self ) {
571		Carp::croak("Failed to load YAML document from string");
572		}
573		if ( wantarray ) {
574		return @$self;
575		} else {
576		# To match YAML.pm, return the last document
577		return $self->[-1];
578		}
579		}
580
581		BEGIN {
582		freeze = Dump;
583		thaw = Load;
584		}
585
586		sub DumpFile {
587		my $file = shift;
588		YAML::Tiny->new(@_)->write($file);
589		}
590
591		sub LoadFile {
592		my $self = YAML::Tiny->read($_[0]);
593		unless ( $self ) {
594		Carp::croak("Failed to load YAML document from '" . ($_[0] \|\| '') . "'");
595		}
596		if ( wantarray ) {
597		return @$self;
598		} else {
599		# Return only the last document to match YAML.pm,
600		return $self->[-1];
601		}
602		}
603
604
605
606
607
608		#####################################################################
609		# Use Scalar::Util if possible, otherwise emulate it
610
611		BEGIN {
612		local $@;
613		eval {
614		require Scalar::Util;
615		};
616		my $v = eval("$Scalar::Util::VERSION") \|\| 0;
617		if ( $@ or $v < 1.18 ) {
618		eval <<'END_PERL';
619		# Scalar::Util failed to load or too old
620		sub refaddr {
621		my $pkg = ref($_[0]) or return undef;
622		if ( !! UNIVERSAL::can($_[0], 'can') ) {
623		bless $_[0], 'Scalar::Util::Fake';
624		} else {
625		$pkg = undef;
626		}
627		"$_[0]" =~ /0x(\w+)/;
628		my $i = do { local $^W; hex $1 };
629		bless $_[0], $pkg if defined $pkg;
630		$i;
631		}
632		END_PERL
633		} else {
634		refaddr = Scalar::Util::refaddr;
635		}
636		}
637
638		1;
639
640		__END__
641
642		#line 1175

-416

~~inc/unicore/Name.pm~~ less more

0		#line 1
1		# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
2		# This file is machine-generated by lib/unicore/mktables from the Unicode
3		# database, Version 6.1.0. Any changes made here will be lost!
4
5
6		# !!!!!!! INTERNAL PERL USE ONLY !!!!!!!
7		# This file is for internal use by core Perl only. The format and even the
8		# name or existence of this file are subject to change without notice. Don't
9		# use it directly.
10
11
12		package charnames;
13
14		# This module contains machine-generated tables and code for the
15		# algorithmically-determinable Unicode character names. The following
16		# routines can be used to translate between name and code point and vice versa
17
18		{ # Closure
19
20		# Matches legal code point. 4-6 hex numbers, If there are 6, the first
21		# two must be 10; if there are 5, the first must not be a 0. Written this
22		# way to decrease backtracking. The first regex allows the code point to
23		# be at the end of a word, but to work properly, the word shouldn't end
24		# with a valid hex character. The second one won't match a code point at
25		# the end of a word, and doesn't have the run-on issue
26		my $run_on_code_point_re = qr/(?^aax: (?: 10[0-9A-F]{4} \| [1-9A-F][0-9A-F]{4} \| [0-9A-F]{4} ) \b)/;
27		my $code_point_re = qr/(?^aa:\b(?^aax: (?: 10[0-9A-F]{4} \| [1-9A-F][0-9A-F]{4} \| [0-9A-F]{4} ) \b))/;
28
29		# In the following hash, the keys are the bases of names which includes
30		# the code point in the name, like CJK UNIFIED IDEOGRAPH-4E01. The values
31		# of each key is another hash which is used to get the low and high ends
32		# for each range of code points that apply to the name.
33		my %names_ending_in_code_point = (
34		'CJK COMPATIBILITY IDEOGRAPH' =>
35		{
36		'high' =>
37		[
38		64109,
39		64217,
40		195101,
41		],
42		'low' =>
43		[
44		63744,
45		64112,
46		194560,
47		],
48		},
49		'CJK UNIFIED IDEOGRAPH' =>
50		{
51		'high' =>
52		[
53		19893,
54		40908,
55		173782,
56		177972,
57		178205,
58		],
59		'low' =>
60		[
61		13312,
62		19968,
63		131072,
64		173824,
65		177984,
66		],
67		},
68
69		);
70
71		# The following hash is a copy of the previous one, except is for loose
72		# matching, so each name has blanks and dashes squeezed out
73		my %loose_names_ending_in_code_point = (
74		'CJKCOMPATIBILITYIDEOGRAPH' =>
75		{
76		'high' =>
77		[
78		64109,
79		64217,
80		195101,
81		],
82		'low' =>
83		[
84		63744,
85		64112,
86		194560,
87		],
88		},
89		'CJKUNIFIEDIDEOGRAPH' =>
90		{
91		'high' =>
92		[
93		19893,
94		40908,
95		173782,
96		177972,
97		178205,
98		],
99		'low' =>
100		[
101		13312,
102		19968,
103		131072,
104		173824,
105		177984,
106		],
107		},
108
109		);
110
111		# And the following array gives the inverse mapping from code points to
112		# names. Lowest code points are first
113		my @code_points_ending_in_code_point = (
114
115		{
116		'high' => 19893,
117		'low' => 13312,
118		'name' => 'CJK UNIFIED IDEOGRAPH',
119		},
120		{
121		'high' => 40908,
122		'low' => 19968,
123		'name' => 'CJK UNIFIED IDEOGRAPH',
124		},
125		{
126		'high' => 64109,
127		'low' => 63744,
128		'name' => 'CJK COMPATIBILITY IDEOGRAPH',
129		},
130		{
131		'high' => 64217,
132		'low' => 64112,
133		'name' => 'CJK COMPATIBILITY IDEOGRAPH',
134		},
135		{
136		'high' => 173782,
137		'low' => 131072,
138		'name' => 'CJK UNIFIED IDEOGRAPH',
139		},
140		{
141		'high' => 177972,
142		'low' => 173824,
143		'name' => 'CJK UNIFIED IDEOGRAPH',
144		},
145		{
146		'high' => 178205,
147		'low' => 177984,
148		'name' => 'CJK UNIFIED IDEOGRAPH',
149		},
150		{
151		'high' => 195101,
152		'low' => 194560,
153		'name' => 'CJK COMPATIBILITY IDEOGRAPH',
154		},
155		,
156
157		);
158
159		# Convert from code point to Jamo short name for use in composing Hangul
160		# syllable names
161		my %Jamo = (
162		4352 => 'G',
163		4353 => 'GG',
164		4354 => 'N',
165		4355 => 'D',
166		4356 => 'DD',
167		4357 => 'R',
168		4358 => 'M',
169		4359 => 'B',
170		4360 => 'BB',
171		4361 => 'S',
172		4362 => 'SS',
173		4363 => '',
174		4364 => 'J',
175		4365 => 'JJ',
176		4366 => 'C',
177		4367 => 'K',
178		4368 => 'T',
179		4369 => 'P',
180		4370 => 'H',
181		4449 => 'A',
182		4450 => 'AE',
183		4451 => 'YA',
184		4452 => 'YAE',
185		4453 => 'EO',
186		4454 => 'E',
187		4455 => 'YEO',
188		4456 => 'YE',
189		4457 => 'O',
190		4458 => 'WA',
191		4459 => 'WAE',
192		4460 => 'OE',
193		4461 => 'YO',
194		4462 => 'U',
195		4463 => 'WEO',
196		4464 => 'WE',
197		4465 => 'WI',
198		4466 => 'YU',
199		4467 => 'EU',
200		4468 => 'YI',
201		4469 => 'I',
202		4520 => 'G',
203		4521 => 'GG',
204		4522 => 'GS',
205		4523 => 'N',
206		4524 => 'NJ',
207		4525 => 'NH',
208		4526 => 'D',
209		4527 => 'L',
210		4528 => 'LG',
211		4529 => 'LM',
212		4530 => 'LB',
213		4531 => 'LS',
214		4532 => 'LT',
215		4533 => 'LP',
216		4534 => 'LH',
217		4535 => 'M',
218		4536 => 'B',
219		4537 => 'BS',
220		4538 => 'S',
221		4539 => 'SS',
222		4540 => 'NG',
223		4541 => 'J',
224		4542 => 'C',
225		4543 => 'K',
226		4544 => 'T',
227		4545 => 'P',
228		4546 => 'H',
229
230		);
231
232		# Leading consonant (can be null)
233		my %Jamo_L = (
234		'' => 11,
235		'B' => 7,
236		'BB' => 8,
237		'C' => 14,
238		'D' => 3,
239		'DD' => 4,
240		'G' => 0,
241		'GG' => 1,
242		'H' => 18,
243		'J' => 12,
244		'JJ' => 13,
245		'K' => 15,
246		'M' => 6,
247		'N' => 2,
248		'P' => 17,
249		'R' => 5,
250		'S' => 9,
251		'SS' => 10,
252		'T' => 16,
253
254		);
255
256		# Vowel
257		my %Jamo_V = (
258		'A' => 0,
259		'AE' => 1,
260		'E' => 5,
261		'EO' => 4,
262		'EU' => 18,
263		'I' => 20,
264		'O' => 8,
265		'OE' => 11,
266		'U' => 13,
267		'WA' => 9,
268		'WAE' => 10,
269		'WE' => 15,
270		'WEO' => 14,
271		'WI' => 16,
272		'YA' => 2,
273		'YAE' => 3,
274		'YE' => 7,
275		'YEO' => 6,
276		'YI' => 19,
277		'YO' => 12,
278		'YU' => 17,
279
280		);
281
282		# Optional trailing consonant
283		my %Jamo_T = (
284		'B' => 17,
285		'BS' => 18,
286		'C' => 23,
287		'D' => 7,
288		'G' => 1,
289		'GG' => 2,
290		'GS' => 3,
291		'H' => 27,
292		'J' => 22,
293		'K' => 24,
294		'L' => 8,
295		'LB' => 11,
296		'LG' => 9,
297		'LH' => 15,
298		'LM' => 10,
299		'LP' => 14,
300		'LS' => 12,
301		'LT' => 13,
302		'M' => 16,
303		'N' => 4,
304		'NG' => 21,
305		'NH' => 6,
306		'NJ' => 5,
307		'P' => 26,
308		'S' => 19,
309		'SS' => 20,
310		'T' => 25,
311
312		);
313
314		# Computed re that splits up a Hangul name into LVT or LV syllables
315		my $syllable_re = qr/(\|B\|BB\|C\|D\|DD\|G\|GG\|H\|J\|JJ\|K\|M\|N\|P\|R\|S\|SS\|T)(A\|AE\|E\|EO\|EU\|I\|O\|OE\|U\|WA\|WAE\|WE\|WEO\|WI\|YA\|YAE\|YE\|YEO\|YI\|YO\|YU)(B\|BS\|C\|D\|G\|GG\|GS\|H\|J\|K\|L\|LB\|LG\|LH\|LM\|LP\|LS\|LT\|M\|N\|NG\|NH\|NJ\|P\|S\|SS\|T)?/;
316
317		my $HANGUL_SYLLABLE = "HANGUL SYLLABLE ";
318		my $loose_HANGUL_SYLLABLE = "HANGULSYLLABLE";
319
320		# These constants names and values were taken from the Unicode standard,
321		# version 5.1, section 3.12. They are used in conjunction with Hangul
322		# syllables
323		my $SBase = 0xAC00;
324		my $LBase = 0x1100;
325		my $VBase = 0x1161;
326		my $TBase = 0x11A7;
327		my $SCount = 11172;
328		my $LCount = 19;
329		my $VCount = 21;
330		my $TCount = 28;
331		my $NCount = $VCount * $TCount;
332
333		sub name_to_code_point_special {
334		my ($name, $loose) = @_;
335
336		# Returns undef if not one of the specially handled names; otherwise
337		# returns the code point equivalent to the input name
338		# $loose is non-zero if to use loose matching, 'name' in that case
339		# must be input as upper case with all blanks and dashes squeezed out.
340
341		if ((! $loose && $name =~ s/$HANGUL_SYLLABLE//)
342		\|\| ($loose && $name =~ s/$loose_HANGUL_SYLLABLE//))
343		{
344		return if $name !~ qr/^$syllable_re$/;
345		my $L = $Jamo_L{$1};
346		my $V = $Jamo_V{$2};
347		my $T = (defined $3) ? $Jamo_T{$3} : 0;
348		return ($L * $VCount + $V) * $TCount + $T + $SBase;
349		}
350
351		# Name must end in 'code_point' for this to handle.
352		return if (($loose && $name !~ /^ (.*?) ($run_on_code_point_re) $/x)
353		\|\| (! $loose && $name !~ /^ (.*) ($code_point_re) $/x));
354
355		my $base = $1;
356		my $code_point = CORE::hex $2;
357		my $names_ref;
358
359		if ($loose) {
360		$names_ref = \%loose_names_ending_in_code_point;
361		}
362		else {
363		return if $base !~ s/-$//;
364		$names_ref = \%names_ending_in_code_point;
365		}
366
367		# Name must be one of the ones which has the code point in it.
368		return if ! $names_ref->{$base};
369
370		# Look through the list of ranges that apply to this name to see if
371		# the code point is in one of them.
372		for (my $i = 0; $i < scalar @{$names_ref->{$base}{'low'}}; $i++) {
373		return if $names_ref->{$base}{'low'}->[$i] > $code_point;
374		next if $names_ref->{$base}{'high'}->[$i] < $code_point;
375
376		# Here, the code point is in the range.
377		return $code_point;
378		}
379
380		# Here, looked like the name had a code point number in it, but
381		# did not match one of the valid ones.
382		return;
383		}
384
385		sub code_point_to_name_special {
386		my $code_point = shift;
387
388		# Returns the name of a code point if algorithmically determinable;
389		# undef if not
390
391		# If in the Hangul range, calculate the name based on Unicode's
392		# algorithm
393		if ($code_point >= $SBase && $code_point <= $SBase + $SCount -1) {
394		use integer;
395		my $SIndex = $code_point - $SBase;
396		my $L = $LBase + $SIndex / $NCount;
397		my $V = $VBase + ($SIndex % $NCount) / $TCount;
398		my $T = $TBase + $SIndex % $TCount;
399		$name = "$HANGUL_SYLLABLE$Jamo{$L}$Jamo{$V}";
400		$name .= $Jamo{$T} if $T != $TBase;
401		return $name;
402		}
403
404		# Look through list of these code points for one in range.
405		foreach my $hash (@code_points_ending_in_code_point) {
406		return if $code_point < $hash->{'low'};
407		if ($code_point <= $hash->{'high'}) {
408		return sprintf("%s-%04X", $hash->{'name'}, $code_point);
409		}
410		}
411		return; # None found
412		}
413		} # End closure
414
415		1;

-3

lib/HTML/HTML5/Entities.pm less more

6	6
7	7	BEGIN {
8	8	$HTML::HTML5::Entities::AUTHORITY = 'cpan:TOBYINK';
9		$HTML::HTML5::Entities::VERSION = '0.003';
	9	$HTML::HTML5::Entities::VERSION = '0.004';
10	10	}
11	11
12	12	our (%entity2char, %char2entity, $hex, $default_unsafe_characters, @EXPORT, @EXPORT_OK);

2525	2525	for (@$array)
2526	2526	{
2527	2527	s/
2528		(&
	2528	&(
2529	2529	(?:
2530	2530	\#(\d+) \| \#[xX]([0-9a-fA-F]+) \| (\w+)
2531	2531	)

2537	2537	elsif (defined $3)
2538	2538	{ chr(hex $3); }
2539	2539	else
2540		{ $entity2char{$4} \|\| $1; }
	2540	{ $entity2char{"$4;"} \|\| "&$1"; }
2541	2541	/xeg;
2542	2542	}
2543	2543

-38

~~meta/changes.ttl~~ less more

0		# This file acts as the project's changelog.
1
2		@prefix : <http://usefulinc.com/ns/doap#> .
3		@prefix dcs: <http://ontologi.es/doap-changeset#> .
4		@prefix dc: <http://purl.org/dc/terms/> .
5		@prefix dist: <http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/> .
6		@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> .
7		@prefix xsd: <http://www.w3.org/2001/XMLSchema#> .
8
9		dist:project :release dist:v_0-001 .
10		dist:v_0-001
11		a :Version ;
12		dc:issued "2011-10-07"^^xsd:date ;
13		:revision "0.001"^^xsd:string ;
14		:file-release <http://backpan.cpan.org/authors/id/T/TO/TOBYINK/HTML-HTML5-Entities-0.001.tar.gz> ;
15		rdfs:label "Initial release" .
16
17		dist:project :release dist:v_0-002 .
18		dist:v_0-002
19		a :Version ;
20		dc:issued "2012-01-16"^^xsd:date ;
21		:revision "0.002"^^xsd:string ;
22		:file-release <http://backpan.cpan.org/authors/id/T/TO/TOBYINK/HTML-HTML5-Entities-0.002.tar.gz> ;
23		dcs:changeset [
24		dcs:versus dist:v_0-001 ;
25		dcs:item [ rdfs:label "%char2entity is now a more conservative mapping, based on XHTML 1.0 (but without apos). This makes it safer for serialising XHTML 1.x, HTML4 and HTML5 documents."@en ] ;
26		].
27
28		dist:project :release dist:v_0-003 .
29		dist:v_0-003
30		a :Version ;
31		dc:issued "2012-06-26"^^xsd:date ;
32		:revision "0.003"^^xsd:string ;
33		:file-release <http://backpan.cpan.org/authors/id/T/TO/TOBYINK/HTML-HTML5-Entities-0.003.tar.gz> ;
34		dcs:changeset [
35		dcs:versus dist:v_0-002 ;
36		dcs:item [ rdfs:label "Drop non-core dependencies."@en ] ;
37		].

-23

~~meta/doap.ttl~~ less more

0		# This file contains general metadata about the project.
1
2		@prefix : <http://usefulinc.com/ns/doap#> .
3		@prefix dc: <http://purl.org/dc/terms/> .
4		@prefix foaf: <http://xmlns.com/foaf/0.1/> .
5		@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> .
6		@prefix xsd: <http://www.w3.org/2001/XMLSchema#> .
7
8		<http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/project>
9		a :Project ;
10		:programming-language "Perl" ;
11		:name "HTML-HTML5-Entities" ;
12		:shortdesc "drop-in replacement for HTML::Entities" ;
13		:homepage <https://metacpan.org/release/HTML-HTML5-Entities> ;
14		:download-page <https://metacpan.org/release/HTML-HTML5-Entities> ;
15		:bug-database <http://rt.cpan.org/Dist/Display.html?Queue=HTML-HTML5-Entities> ;
16		:created "2011-10-06"^^xsd:date ;
17		:license <http://dev.perl.org/licenses/> ;
18		:developer [ a foaf:Person ; foaf:name "Toby Inkster" ; foaf:mbox <mailto:tobyink@cpan.org> ] .
19
20		<http://dev.perl.org/licenses/>
21		dc:title "the same terms as the perl 5 programming language system itself" .
22

-12

~~meta/makefile.ttl~~ less more

0		# This file provides instructions for packaging.
1
2		@prefix : <http://purl.org/NET/cpan-uri/terms#> .
3
4		<http://purl.org/NET/cpan-uri/dist/HTML-HTML5-Entities/project>
5		:perl_version_from _:main ;
6		:version_from _:main ;
7		:readme_from _:main ;
8		:test_requires "Test::More 0.61" .
9
10		_:main <http://www.semanticdesktop.org/ontologies/2007/03/22/nfo#fileName> "lib/HTML/HTML5/Entities.pm" .
11

-1

t/03decoding.t less more

0	0	use Test::More tests => 7;
1		use HTML::HTML5::Entities qw[decode_entities _decode_entities %entity2char];
	1	use HTML::HTML5::Entities qw[
	2	encode_entities decode_entities _decode_entities %entity2char
	3	];
2	4
3	5	is(decode_entities('&'), '&', 'decode_entities works');
4	6	is(decode_entities('a&b'), 'a&b', 'non-entities passed though');

+11

-0

t/04roundtrip.t less more

	0	use Test::More tests => 1;
	1	use HTML::HTML5::Entities qw[
	2	encode_entities decode_entities _decode_entities %entity2char
	3	];
	4
	5	my $orig = my $in = 'é&€';
	6	is(
	7	encode_entities( decode_entities($in), qr/./ ),
	8	$orig,
	9	'more complex example',
	10	) or diag decode_entities($orig);