Commit 726c74b384e747c2207aedd644e0a89624d97e9a - libmoosex-params-validate-perl

+16

-11

ChangeLog less more

0	0	Revision history for Perl extension MooseX-Params-Validate
	1
	2	0.15
	3	- Add MX_PARAMS_VALIDATE_ALLOW_EXTRA which allows extra parameters in
	4	validation calls (like allow_extra for Params::Validate).
	5	- Converted to Test::Fatal.
1	6
2	7	0.14 Sun. Mar. 18, 2010
3	8	- The validated_hash method failed when called on in an overloaded

20	25	0.11 Tue. Jul. 7, 2009
21	26	- The validation functions tried to coerce optional keys which
22	27	weren't present in the incoming parameters, leading to weird
23		errors. Based on a patch from Jos Boumans. RT #46344.
	28	errors. Based on a patch from Jos Boumans. RT #46344.
24	29
25	30	- Allow other callbacks to be specified. Previously these were
26	31	silently thrown out. But we'd recommend just defining types that
27	32	encapsulate everything in the callback instead. Based on a patch
28	33	from Jos Boumans. RT #47647.
29
	34
30	35	0.10 Tue. Jun. 30, 2009
31	36	- Shut up deprecation warnings from the tests. Reported by John
32	37	Goulah.

45	50	- Errors now reflect the subroutine that called the validation
46	51	function, rather than coming form inside the validation function
47	52	itself.
48
	53
49	54	0.07 Sun. Sep. 21, 2008
50	55	- No code changes, just fixing missing prereqs (Dave Rolsky)
51	56

65	70	- upped the Moose dependency and added support
66	71	for the new improved Moose type constraints
67	72	- added tests for this
68
69		- adding caching of the prepared parameter
70		specs, this results in approx. 3x speedup
71		using rough benchmarks.
72
73		- added special caching handlers see the
74		IMPORTANT NOTE ON CACHING section of the
	73
	74	- adding caching of the prepared parameter
	75	specs, this results in approx. 3x speedup
	76	using rough benchmarks.
	77
	78	- added special caching handlers see the
	79	IMPORTANT NOTE ON CACHING section of the
75	80	POD for more details
76	81	- added tests for this
77	82
78	83	0.03 Fri. June 8th, 2007
79		- added support for using this
	84	- added support for using this
80	85	within role methods too.
81	86
82	87	0.02 Wed. April 25, 2007

+44

-0

INSTALL less more

	0
	1	This is the Perl distribution MooseX-Params-Validate.
	2
	3	Installing MooseX-Params-Validate is straightforward.
	4
	5	## Installation with cpanm
	6
	7	If you have cpanm, you only need one line:
	8
	9	% cpanm MooseX::Params::Validate
	10
	11	If you are installing into a system-wide directory, you may need to pass the
	12	"-S" flag to cpanm, which uses sudo to install the module:
	13
	14	% cpanm -S MooseX::Params::Validate
	15
	16	## Installing with the CPAN shell
	17
	18	Alternatively, if your CPAN shell is set up, you should just be able to do:
	19
	20	% cpan MooseX::Params::Validate
	21
	22	## Manual installation
	23
	24	As a last resort, you can manually install it. Download the tarball, untar it,
	25	then build it:
	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
	38	## Documentation
	39
	40	MooseX-Params-Validate documentation is available as POD.
	41	You can run perldoc from a shell to read the documentation:
	42
	43	% perldoc MooseX::Params::Validate

+377

-0

LICENSE less more

	0	This software is copyright (c) 2010 by Stevan Little <stevan.little@iinteractive.com>.
	1
	2	This is free software; you can redistribute it and/or modify it under
	3	the same terms as the Perl 5 programming language system itself.
	4
	5	Terms of the Perl programming language system itself
	6
	7	a) the GNU General Public License as published by the Free
	8	Software Foundation; either version 1, or (at your option) any
	9	later version, or
	10	b) the "Artistic License"
	11
	12	--- The GNU General Public License, Version 1, February 1989 ---
	13
	14	This software is Copyright (c) 2010 by Stevan Little <stevan.little@iinteractive.com>.
	15
	16	This is free software, licensed under:
	17
	18	The GNU General Public License, Version 1, February 1989
	19
	20	GNU GENERAL PUBLIC LICENSE
	21	Version 1, February 1989
	22
	23	Copyright (C) 1989 Free Software Foundation, Inc.
	24	59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
	25	Everyone is permitted to copy and distribute verbatim copies
	26	of this license document, but changing it is not allowed.
	27
	28	Preamble
	29
	30	The license agreements of most software companies try to keep users
	31	at the mercy of those companies. By contrast, our General Public
	32	License is intended to guarantee your freedom to share and change free
	33	software--to make sure the software is free for all its users. The
	34	General Public License applies to the Free Software Foundation's
	35	software and to any other program whose authors commit to using it.
	36	You can use it for your programs, too.
	37
	38	When we speak of free software, we are referring to freedom, not
	39	price. Specifically, the General Public License is designed to make
	40	sure that you have the freedom to give away or sell copies of free
	41	software, that you receive source code or can get it if you want it,
	42	that you can change the software or use pieces of it in new free
	43	programs; and that you know you can do these things.
	44
	45	To protect your rights, we need to make restrictions that forbid
	46	anyone to deny you these rights or to ask you to surrender the rights.
	47	These restrictions translate to certain responsibilities for you if you
	48	distribute copies of the software, or if you modify it.
	49
	50	For example, if you distribute copies of a such a program, whether
	51	gratis or for a fee, you must give the recipients all the rights that
	52	you have. You must make sure that they, too, receive or can get the
	53	source code. And you must tell them their rights.
	54
	55	We protect your rights with two steps: (1) copyright the software, and
	56	(2) offer you this license which gives you legal permission to copy,
	57	distribute and/or modify the software.
	58
	59	Also, for each author's protection and ours, we want to make certain
	60	that everyone understands that there is no warranty for this free
	61	software. If the software is modified by someone else and passed on, we
	62	want its recipients to know that what they have is not the original, so
	63	that any problems introduced by others will not reflect on the original
	64	authors' reputations.
	65
	66	The precise terms and conditions for copying, distribution and
	67	modification follow.
	68
	69	GNU GENERAL PUBLIC LICENSE
	70	TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
	71
	72	0. This License Agreement applies to any program or other work which
	73	contains a notice placed by the copyright holder saying it may be
	74	distributed under the terms of this General Public License. The
	75	"Program", below, refers to any such program or work, and a "work based
	76	on the Program" means either the Program or any work containing the
	77	Program or a portion of it, either verbatim or with modifications. Each
	78	licensee is addressed as "you".
	79
	80	1. You may copy and distribute verbatim copies of the Program's source
	81	code as you receive it, in any medium, provided that you conspicuously and
	82	appropriately publish on each copy an appropriate copyright notice and
	83	disclaimer of warranty; keep intact all the notices that refer to this
	84	General Public License and to the absence of any warranty; and give any
	85	other recipients of the Program a copy of this General Public License
	86	along with the Program. You may charge a fee for the physical act of
	87	transferring a copy.
	88
	89	2. You may modify your copy or copies of the Program or any portion of
	90	it, and copy and distribute such modifications under the terms of Paragraph
	91	1 above, provided that you also do the following:
	92
	93	a) cause the modified files to carry prominent notices stating that
	94	you changed the files and the date of any change; and
	95
	96	b) cause the whole of any work that you distribute or publish, that
	97	in whole or in part contains the Program or any part thereof, either
	98	with or without modifications, to be licensed at no charge to all
	99	third parties under the terms of this General Public License (except
	100	that you may choose to grant warranty protection to some or all
	101	third parties, at your option).
	102
	103	c) If the modified program normally reads commands interactively when
	104	run, you must cause it, when started running for such interactive use
	105	in the simplest and most usual way, to print or display an
	106	announcement including an appropriate copyright notice and a notice
	107	that there is no warranty (or else, saying that you provide a
	108	warranty) and that users may redistribute the program under these
	109	conditions, and telling the user how to view a copy of this General
	110	Public License.
	111
	112	d) You may charge a fee for the physical act of transferring a
	113	copy, and you may at your option offer warranty protection in
	114	exchange for a fee.
	115
	116	Mere aggregation of another independent work with the Program (or its
	117	derivative) on a volume of a storage or distribution medium does not bring
	118	the other work under the scope of these terms.
	119
	120	3. You may copy and distribute the Program (or a portion or derivative of
	121	it, under Paragraph 2) in object code or executable form under the terms of
	122	Paragraphs 1 and 2 above provided that you also do one of the following:
	123
	124	a) accompany it with the complete corresponding machine-readable
	125	source code, which must be distributed under the terms of
	126	Paragraphs 1 and 2 above; or,
	127
	128	b) accompany it with a written offer, valid for at least three
	129	years, to give any third party free (except for a nominal charge
	130	for the cost of distribution) a complete machine-readable copy of the
	131	corresponding source code, to be distributed under the terms of
	132	Paragraphs 1 and 2 above; or,
	133
	134	c) accompany it with the information you received as to where the
	135	corresponding source code may be obtained. (This alternative is
	136	allowed only for noncommercial distribution and only if you
	137	received the program in object code or executable form alone.)
	138
	139	Source code for a work means the preferred form of the work for making
	140	modifications to it. For an executable file, complete source code means
	141	all the source code for all modules it contains; but, as a special
	142	exception, it need not include source code for modules which are standard
	143	libraries that accompany the operating system on which the executable
	144	file runs, or for standard header files or definitions files that
	145	accompany that operating system.
	146
	147	4. You may not copy, modify, sublicense, distribute or transfer the
	148	Program except as expressly provided under this General Public License.
	149	Any attempt otherwise to copy, modify, sublicense, distribute or transfer
	150	the Program is void, and will automatically terminate your rights to use
	151	the Program under this License. However, parties who have received
	152	copies, or rights to use copies, from you under this General Public
	153	License will not have their licenses terminated so long as such parties
	154	remain in full compliance.
	155
	156	5. By copying, distributing or modifying the Program (or any work based
	157	on the Program) you indicate your acceptance of this license to do so,
	158	and all its terms and conditions.
	159
	160	6. Each time you redistribute the Program (or any work based on the
	161	Program), the recipient automatically receives a license from the original
	162	licensor to copy, distribute or modify the Program subject to these
	163	terms and conditions. You may not impose any further restrictions on the
	164	recipients' exercise of the rights granted herein.
	165
	166	7. The Free Software Foundation may publish revised and/or new versions
	167	of the General Public License from time to time. Such new versions will
	168	be similar in spirit to the present version, but may differ in detail to
	169	address new problems or concerns.
	170
	171	Each version is given a distinguishing version number. If the Program
	172	specifies a version number of the license which applies to it and "any
	173	later version", you have the option of following the terms and conditions
	174	either of that version or of any later version published by the Free
	175	Software Foundation. If the Program does not specify a version number of
	176	the license, you may choose any version ever published by the Free Software
	177	Foundation.
	178
	179	8. If you wish to incorporate parts of the Program into other free
	180	programs whose distribution conditions are different, write to the author
	181	to ask for permission. For software which is copyrighted by the Free
	182	Software Foundation, write to the Free Software Foundation; we sometimes
	183	make exceptions for this. Our decision will be guided by the two goals
	184	of preserving the free status of all derivatives of our free software and
	185	of promoting the sharing and reuse of software generally.
	186
	187	NO WARRANTY
	188
	189	9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
	190	FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
	191	OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
	192	PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
	193	OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
	194	MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
	195	TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
	196	PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
	197	REPAIR OR CORRECTION.
	198
	199	10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
	200	WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
	201	REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
	202	INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
	203	OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
	204	TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
	205	YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
	206	PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
	207	POSSIBILITY OF SUCH DAMAGES.
	208
	209	END OF TERMS AND CONDITIONS
	210
	211	Appendix: How to Apply These Terms to Your New Programs
	212
	213	If you develop a new program, and you want it to be of the greatest
	214	possible use to humanity, the best way to achieve this is to make it
	215	free software which everyone can redistribute and change under these
	216	terms.
	217
	218	To do so, attach the following notices to the program. It is safest to
	219	attach them to the start of each source file to most effectively convey
	220	the exclusion of warranty; and each file should have at least the
	221	"copyright" line and a pointer to where the full notice is found.
	222
	223	<one line to give the program's name and a brief idea of what it does.>
	224	Copyright (C) 19yy <name of author>
	225
	226	This program is free software; you can redistribute it and/or modify
	227	it under the terms of the GNU General Public License as published by
	228	the Free Software Foundation; either version 1, or (at your option)
	229	any later version.
	230
	231	This program is distributed in the hope that it will be useful,
	232	but WITHOUT ANY WARRANTY; without even the implied warranty of
	233	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	234	GNU General Public License for more details.
	235
	236	You should have received a copy of the GNU General Public License
	237	along with this program; if not, write to the Free Software Foundation,
	238	Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
	239
	240	Also add information on how to contact you by electronic and paper mail.
	241
	242	If the program is interactive, make it output a short notice like this
	243	when it starts in an interactive mode:
	244
	245	Gnomovision version 69, Copyright (C) 19xx name of author
	246	Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
	247	This is free software, and you are welcome to redistribute it
	248	under certain conditions; type `show c' for details.
	249
	250	The hypothetical commands `show w' and `show c' should show the
	251	appropriate parts of the General Public License. Of course, the
	252	commands you use may be called something other than `show w' and `show
	253	c'; they could even be mouse-clicks or menu items--whatever suits your
	254	program.
	255
	256	You should also get your employer (if you work as a programmer) or your
	257	school, if any, to sign a "copyright disclaimer" for the program, if
	258	necessary. Here a sample; alter the names:
	259
	260	Yoyodyne, Inc., hereby disclaims all copyright interest in the
	261	program `Gnomovision' (a program to direct compilers to make passes
	262	at assemblers) written by James Hacker.
	263
	264	<signature of Ty Coon>, 1 April 1989
	265	Ty Coon, President of Vice
	266
	267	That's all there is to it!
	268
	269
	270	--- The Artistic License 1.0 ---
	271
	272	This software is Copyright (c) 2010 by Stevan Little <stevan.little@iinteractive.com>.
	273
	274	This is free software, licensed under:
	275
	276	The Artistic License 1.0
	277
	278	The Artistic License
	279
	280	Preamble
	281
	282	The intent of this document is to state the conditions under which a Package
	283	may be copied, such that the Copyright Holder maintains some semblance of
	284	artistic control over the development of the package, while giving the users of
	285	the package the right to use and distribute the Package in a more-or-less
	286	customary fashion, plus the right to make reasonable modifications.
	287
	288	Definitions:
	289
	290	- "Package" refers to the collection of files distributed by the Copyright
	291	Holder, and derivatives of that collection of files created through
	292	textual modification.
	293	- "Standard Version" refers to such a Package if it has not been modified,
	294	or has been modified in accordance with the wishes of the Copyright
	295	Holder.
	296	- "Copyright Holder" is whoever is named in the copyright or copyrights for
	297	the package.
	298	- "You" is you, if you're thinking about copying or distributing this Package.
	299	- "Reasonable copying fee" is whatever you can justify on the basis of media
	300	cost, duplication charges, time of people involved, and so on. (You will
	301	not be required to justify it to the Copyright Holder, but only to the
	302	computing community at large as a market that must bear the fee.)
	303	- "Freely Available" means that no fee is charged for the item itself, though
	304	there may be fees involved in handling the item. It also means that
	305	recipients of the item may redistribute it under the same conditions they
	306	received it.
	307
	308	1. You may make and give away verbatim copies of the source form of the
	309	Standard Version of this Package without restriction, provided that you
	310	duplicate all of the original copyright notices and associated disclaimers.
	311
	312	2. You may apply bug fixes, portability fixes and other modifications derived
	313	from the Public Domain or from the Copyright Holder. A Package modified in such
	314	a way shall still be considered the Standard Version.
	315
	316	3. You may otherwise modify your copy of this Package in any way, provided that
	317	you insert a prominent notice in each changed file stating how and when you
	318	changed that file, and provided that you do at least ONE of the following:
	319
	320	a) place your modifications in the Public Domain or otherwise make them
	321	Freely Available, such as by posting said modifications to Usenet or an
	322	equivalent medium, or placing the modifications on a major archive site
	323	such as ftp.uu.net, or by allowing the Copyright Holder to include your
	324	modifications in the Standard Version of the Package.
	325
	326	b) use the modified Package only within your corporation or organization.
	327
	328	c) rename any non-standard executables so the names do not conflict with
	329	standard executables, which must also be provided, and provide a separate
	330	manual page for each non-standard executable that clearly documents how it
	331	differs from the Standard Version.
	332
	333	d) make other distribution arrangements with the Copyright Holder.
	334
	335	4. You may distribute the programs of this Package in object code or executable
	336	form, provided that you do at least ONE of the following:
	337
	338	a) distribute a Standard Version of the executables and library files,
	339	together with instructions (in the manual page or equivalent) on where to
	340	get the Standard Version.
	341
	342	b) accompany the distribution with the machine-readable source of the Package
	343	with your modifications.
	344
	345	c) accompany any non-standard executables with their corresponding Standard
	346	Version executables, giving the non-standard executables non-standard
	347	names, and clearly documenting the differences in manual pages (or
	348	equivalent), together with instructions on where to get the Standard
	349	Version.
	350
	351	d) make other distribution arrangements with the Copyright Holder.
	352
	353	5. You may charge a reasonable copying fee for any distribution of this
	354	Package. You may charge any fee you choose for support of this Package. You
	355	may not charge a fee for this Package itself. However, you may distribute this
	356	Package in aggregate with other (possibly commercial) programs as part of a
	357	larger (possibly commercial) software distribution provided that you do not
	358	advertise this Package as a product of your own.
	359
	360	6. The scripts and library files supplied as input to or produced as output
	361	from the programs of this Package do not automatically fall under the copyright
	362	of this Package, but belong to whomever generated them, and may be sold
	363	commercially, and may be aggregated with this Package.
	364
	365	7. C or perl subroutines supplied by you and linked into this Package shall not
	366	be considered part of this Package.
	367
	368	8. The name of the Copyright Holder may not be used to endorse or promote
	369	products derived from this software without specific prior written permission.
	370
	371	9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
	372	WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
	373	MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
	374
	375	The End
	376

+16

-17

MANIFEST less more

0	0	ChangeLog
1		inc/Module/Install.pm
2		inc/Module/Install/Base.pm
3		inc/Module/Install/Can.pm
4		inc/Module/Install/Fetch.pm
5		inc/Module/Install/Makefile.pm
6		inc/Module/Install/Metadata.pm
7		inc/Module/Install/Win32.pm
8		inc/Module/Install/WriteAll.pm
	1	INSTALL
	2	LICENSE
	3	MANIFEST
	4	META.json
	5	META.yml
	6	Makefile.PL
	7	README
	8	SIGNATURE
	9	dist.ini
9	10	lib/MooseX/Params/Validate.pm
10		Makefile.PL
11		MANIFEST This list of files
12		META.yml
13		README
14	11	t/000_load.t
15	12	t/001_basic.t
16	13	t/002_basic_list.t

21	18	t/007_deprecated.t
22	19	t/008_positional.t
23	20	t/009_wrapped.t
24		t/010.overloaded.t
25		xt/kwalitee.t
26		xt/pod-coverage.t
27		xt/pod-spell.t
28		xt/pod.t
	21	t/010_overloaded.t
	22	t/011_allow_extra.t
	23	t/release-eol.t
	24	t/release-no-tabs.t
	25	t/release-pod-coverage.t
	26	t/release-pod-spell.t
	27	t/release-pod-syntax.t

+53

-0

META.json less more

	0	{
	1	"abstract" : "an extension of Params::Validate using Moose's types",
	2	"author" : [
	3	"Stevan Little <stevan.little@iinteractive.com>"
	4	],
	5	"dynamic_config" : 0,
	6	"generated_by" : "Dist::Zilla version 4.102345, CPAN::Meta::Converter version 2.101670",
	7	"license" : [
	8	"perl_5"
	9	],
	10	"meta-spec" : {
	11	"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
	12	"version" : "2"
	13	},
	14	"name" : "MooseX-Params-Validate",
	15	"prereqs" : {
	16	"configure" : {
	17	"requires" : {
	18	"ExtUtils::MakeMaker" : "6.31"
	19	}
	20	},
	21	"runtime" : {
	22	"requires" : {
	23	"Carp" : 0,
	24	"Devel::Caller" : 0,
	25	"Moose" : "0.58",
	26	"Params::Validate" : "0.88",
	27	"Scalar::Util" : 0,
	28	"Sub::Exporter" : 0
	29	}
	30	},
	31	"test" : {
	32	"requires" : {
	33	"Test::Fatal" : "0.001",
	34	"Test::More" : "0.88"
	35	}
	36	}
	37	},
	38	"release_status" : "stable",
	39	"resources" : {
	40	"bugtracker" : {
	41	"mailto" : "bug-datetime@rt.cpan.org",
	42	"web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX::Params::Validate"
	43	},
	44	"repository" : {
	45	"type" : "git",
	46	"url" : "git://git.moose.perl.org/MooseX-Params-Validate.git",
	47	"web" : "http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo/MooseX-Params-Validate.git"
	48	}
	49	},
	50	"version" : "0.15"
	51	}
	52

+10

-16

META.yml less more

0	0	---
1		abstract: "an extension of Params::Validate for using Moose's types"
	1	abstract: "an extension of Params::Validate using Moose's types"
2	2	author:
3	3	- 'Stevan Little <stevan.little@iinteractive.com>'
4	4	build_requires:
5		ExtUtils::MakeMaker: 6.42
6		Test::Exception: 0.21
7		Test::More: 0.62
	5	Test::Fatal: 0.001
	6	Test::More: 0.88
8	7	configure_requires:
9		ExtUtils::MakeMaker: 6.42
10		distribution_type: module
11		generated_by: 'Module::Install version 0.91'
12		license: Perl
	8	ExtUtils::MakeMaker: 6.31
	9	dynamic_config: 0
	10	generated_by: 'Dist::Zilla version 4.102345, CPAN::Meta::Converter version 2.101670'
	11	license: perl
13	12	meta-spec:
14	13	url: http://module-build.sourceforge.net/META-spec-v1.4.html
15	14	version: 1.4
16	15	name: MooseX-Params-Validate
17		no_index:
18		directory:
19		- inc
20		- t
21		- xt
22	16	requires:
23	17	Carp: 0
24	18	Devel::Caller: 0

27	21	Scalar::Util: 0
28	22	Sub::Exporter: 0
29	23	resources:
30		license: http://dev.perl.org/licenses/
31		repository: http://code2.0beta.co.uk/moose/svn/MooseX-Params-Validate
32		version: 0.14
	24	bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX::Params::Validate
	25	repository: git://git.moose.perl.org/MooseX-Params-Validate.git
	26	version: 0.15

+51

-15

Makefile.PL less more

	0
0	1	use strict;
1	2	use warnings;
2		use inc::Module::Install 0.91;
3
4		name 'MooseX-Params-Validate';
5		all_from 'lib/MooseX/Params/Validate.pm';
6	3
7	4
8		requires 'Carp' => '0';
9		requires 'Devel::Caller' => '0';
10		requires 'Moose' => '0.58';
11		requires 'Params::Validate' => '0.88';
12		requires 'Scalar::Util' => '0';
13		requires 'Sub::Exporter' => '0';
14	5
15		build_requires 'Test::More' => '0.62';
16		build_requires 'Test::Exception' => '0.21';
	6	use ExtUtils::MakeMaker 6.31;
17	7
18		license 'Perl';
19	8
20		resources repository => 'http://code2.0beta.co.uk/moose/svn/MooseX-Params-Validate';
21	9
22		WriteAll();
	10	my %WriteMakefileArgs = (
	11	'ABSTRACT' => 'an extension of Params::Validate using Moose\'s types',
	12	'AUTHOR' => 'Stevan Little <stevan.little@iinteractive.com>',
	13	'BUILD_REQUIRES' => {
	14	'Test::Fatal' => '0.001',
	15	'Test::More' => '0.88'
	16	},
	17	'CONFIGURE_REQUIRES' => {
	18	'ExtUtils::MakeMaker' => '6.31'
	19	},
	20	'DISTNAME' => 'MooseX-Params-Validate',
	21	'EXE_FILES' => [],
	22	'LICENSE' => 'perl',
	23	'NAME' => 'MooseX::Params::Validate',
	24	'PREREQ_PM' => {
	25	'Carp' => '0',
	26	'Devel::Caller' => '0',
	27	'Moose' => '0.58',
	28	'Params::Validate' => '0.88',
	29	'Scalar::Util' => '0',
	30	'Sub::Exporter' => '0'
	31	},
	32	'VERSION' => '0.15',
	33	'test' => {
	34	'TESTS' => 't/*.t'
	35	}
	36	);
	37
	38
	39	unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) {
	40	my $br = delete $WriteMakefileArgs{BUILD_REQUIRES};
	41	my $pp = $WriteMakefileArgs{PREREQ_PM};
	42	for my $mod ( keys %$br ) {
	43	if ( exists $pp->{$mod} ) {
	44	$pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod};
	45	}
	46	else {
	47	$pp->{$mod} = $br->{$mod};
	48	}
	49	}
	50	}
	51
	52	delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
	53	unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
	54
	55	WriteMakefile(%WriteMakefileArgs);
	56
	57
	58

+6

-23

README less more

0		MooseX::Params::Validate version 0.13
1		===========================
2	0
3		See the individual module documentation for more information
4	1
5		INSTALLATION
	2	This archive contains the distribution MooseX-Params-Validate,
	3	version 0.15:
6	4
7		To install this module type the following:
	5	an extension of Params::Validate using Moose's types
8	6
9		perl Makefile.PL
10		make
11		make test
12		make install
	7	This software is copyright (c) 2010 by Stevan Little <stevan.little@iinteractive.com>.
13	8
14		DEPENDENCIES
	9	This is free software; you can redistribute it and/or modify it under
	10	the same terms as the Perl 5 programming language system itself.
15	11
16		This module requires these other modules and libraries:
17	12
18		Moose
19		Params::Validate
20
21		COPYRIGHT AND LICENCE
22
23		Copyright (C) 2007-2008 Infinity Interactive, Inc.
24
25		http://www.iinteractive.com
26
27		This library is free software; you can redistribute it and/or modify
28		it under the same terms as Perl itself.
29

+50

-0

SIGNATURE less more

	0	This file contains message digests of all files listed in MANIFEST,
	1	signed via the Module::Signature module, version 0.61.
	2
	3	To verify the content in this distribution, first make sure you have
	4	Module::Signature installed, then type:
	5
	6	% cpansign -v
	7
	8	It will check each file's integrity, as well as the signature's
	9	validity. If "==> Signature verified OK! <==" is not displayed,
	10	the distribution may already have been compromised, and you should
	11	not run its Makefile.PL or Build.PL.
	12
	13	-----BEGIN PGP SIGNED MESSAGE-----
	14	Hash: SHA1
	15
	16	SHA1 817f3de5af1b184b7fc03e50dcb535c7fa2510c7 ChangeLog
	17	SHA1 cc4d2fab66c18673004f62a31d4d5e0336bbfe8a INSTALL
	18	SHA1 c2e7f481b3423397eee994d1272293bdd956d261 LICENSE
	19	SHA1 288714ab3375009ab4f947b15411d4cef2437d28 MANIFEST
	20	SHA1 67a1c067dedcae42c9520eac5bf6805e4f6b5b6d META.json
	21	SHA1 c9a9209e6caa86aaf270d60e8134607e5438f378 META.yml
	22	SHA1 1a9e5c8ed8b142a5002dbbe5374796dfb63e4ead Makefile.PL
	23	SHA1 8c9fce17e16b4c9c0da8f73792e2ad95e7bd1755 README
	24	SHA1 915673a4ab4960ab9c2dfda83c808d96022b4912 dist.ini
	25	SHA1 ddc5e51be198964d648fbe661e2f5d882a3d5bf9 lib/MooseX/Params/Validate.pm
	26	SHA1 26d791d014ba8912b754a21d94a53c120ffab187 t/000_load.t
	27	SHA1 9ae33440d43635ab30fdbed609aad4b3ff830420 t/001_basic.t
	28	SHA1 cda4c07346a1fb86d55c51fb498b66ba5ce2cc1c t/002_basic_list.t
	29	SHA1 a5cc6e8070743463d6af57685eb8d27f00f69993 t/003_nocache_flag.t
	30	SHA1 027d9855cefa7097ac998067da9b3c3ea9cd0844 t/004_custom_cache_key.t
	31	SHA1 39c271010d7d5c00e21d1c7e00b990ee1f3135ff t/005_coercion.t
	32	SHA1 6d56e5bbaa66a57d12be1b31581675c40a71115f t/006_not_moose.t
	33	SHA1 38afb967c7f58dd4a54763244647623be10bf07b t/007_deprecated.t
	34	SHA1 8d7690661e1b9eb5dc7ceef9c16dd4db601dfc18 t/008_positional.t
	35	SHA1 76bc8865bfd1fd344994252aea881fee194a1cbb t/009_wrapped.t
	36	SHA1 ae17b92bd2f8a376d7ab5a830110394d59e5adb1 t/010_overloaded.t
	37	SHA1 5eba65d7bd97ce02725da6e5a90c8b261ff80a89 t/011_allow_extra.t
	38	SHA1 a032c41ef6887fab1b900669c2d304fab46680e2 t/release-eol.t
	39	SHA1 455d1dd1867212a665ad5ea4126b572411de300c t/release-no-tabs.t
	40	SHA1 287ab1af698d8e0e25b88242dd22162da726cd74 t/release-pod-coverage.t
	41	SHA1 b9b79a13a0d702407ea729f5f4e41bae3e882c58 t/release-pod-spell.t
	42	SHA1 b30cbdfaf935017c4568c0c91b242438cb87786e t/release-pod-syntax.t
	43	-----BEGIN PGP SIGNATURE-----
	44	Version: GnuPG v1.4.10 (GNU/Linux)
	45
	46	iEYEARECAAYFAkz0LVwACgkQIgMCsV8qvRIIUACeIY6SNldw+GowwK2ROgKEjv5m
	47	oyoAnjlmE6AbQbjCXC/4iHiPKG2jhEjO
	48	=Do5v
	49	-----END PGP SIGNATURE-----

+12

-0

debian/changelog less more

	0	libmoosex-params-validate-perl (0.15-1) unstable; urgency=low
	1
	2	* New upstream release.
	3	* Build-depend on libtest-fatal-perl instead of libtest-exception-perl.
	4	* Add build-dep on perl (>= 5.10.1) \| libtest-simple-perl (>= 0.88).
	5	* debian/copyright: Update for new release; refer to "Debian systems"
	6	instead of "Debian GNU/Linux systems"; refer to GPL-1.
	7	* Bump Standards-Version to 3.9.1.
	8	* Add myself to Uploaders.
	9
	10	-- Ansgar Burchardt <ansgar@debian.org> Wed, 01 Dec 2010 19:02:15 +0100
	11
0	12	libmoosex-params-validate-perl (0.14-1) unstable; urgency=low
1	13
2	14	* New upstream release

+5

-4

debian/control less more

2	2	Priority: optional
3	3	Build-Depends: debhelper (>= 7)
4	4	Build-Depends-Indep: perl, libmoose-perl (>= 0.58), libsub-exporter-perl,
5		libparams-validate-perl (>= 0.88), libtest-exception-perl,
6		libdevel-caller-perl
	5	libparams-validate-perl (>= 0.88), libtest-fatal-perl,
	6	libdevel-caller-perl, perl (>= 5.10.1) \| libtest-simple-perl (>= 0.88)
7	7	Maintainer: Debian Perl Group <pkg-perl-maintainers@lists.alioth.debian.org>
8		Uploaders: Jonathan Yu <jawnsy@cpan.org>
9		Standards-Version: 3.8.4
	8	Uploaders: Jonathan Yu <jawnsy@cpan.org>,
	9	Ansgar Burchardt <ansgar@debian.org>
	10	Standards-Version: 3.9.1
10	11	Homepage: http://search.cpan.org/dist/MooseX-Params-Validate/
11	12	Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libmoosex-params-validate-perl/
12	13	Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libmoosex-params-validate-perl/

+5

-12

debian/copyright less more

3	3	Name: MooseX-Params-Validate
4	4
5	5	Files: *
6		Copyright: 2007-2009, Infinity Interactive, Inc.
7		License: Artistic or GPL-1+
8
9		Files: inc/Module/*
10		Copyright: 2002-2010, Adam Kennedy <adamk@cpan.org>
11		2002-2010, Audrey Tang <autrijus@autrijus.org>
12		2002-2010, Brian Ingerson <ingy@cpan.org>
	6	Copyright: 2010, Stevan Little <stevan.little@iinteractive.com>
13	7	License: Artistic or GPL-1+
14	8
15	9	Files: debian/*

20	14	This program is free software; you can redistribute it and/or modify
21	15	it under the terms of the Artistic License, which comes with Perl.
22	16	.
23		On Debian GNU/Linux systems, the complete text of the Artistic License
24		can be found in `/usr/share/common-licenses/Artistic'
	17	On Debian systems, the complete text of the Artistic License can be
	18	found in `/usr/share/common-licenses/Artistic'
25	19
26	20	License: GPL-1+
27	21	This program is free software; you can redistribute it and/or modify

29	23	the Free Software Foundation; either version 1, or (at your option)
30	24	any later version.
31	25	.
32		On Debian GNU/Linux systems, the complete text of the GNU General
33		Public License can be found in `/usr/share/common-licenses/GPL'
34
	26	On Debian systems, the complete text of version 1 of the GNU General
	27	Public License can be found in `/usr/share/common-licenses/GPL-1'.

+1

-0

debian/source/format less more

0

3.0 (quilt)

+44

-0

dist.ini less more

	0	name = MooseX-Params-Validate
	1	version = 0.15
	2	author = Stevan Little <stevan.little@iinteractive.com>
	3	license = Perl_5
	4	copyright_holder = Stevan Little <stevan.little@iinteractive.com>
	5
	6	[Authority]
	7	authority = cpan:STEVAN
	8
	9	[@Basic]
	10
	11	[PkgVersion]
	12
	13	[InstallGuide]
	14	[MetaJSON]
	15
	16	[MetaResources]
	17	bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX::Params::Validate
	18	bugtracker.mailto = bug-datetime@rt.cpan.org
	19	repository.url = git://git.moose.perl.org/MooseX-Params-Validate.git
	20	repository.web = http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo/MooseX-Params-Validate.git
	21	repository.type = git
	22
	23	[PodWeaver]
	24	[PodSyntaxTests]
	25	[NoTabsTests]
	26	[EOLTests]
	27	[Signature]
	28
	29	[CheckChangeLog]
	30
	31	[Prereqs]
	32	Carp = 0
	33	Devel::Caller = 0
	34	Moose = 0.58
	35	Params::Validate = 0.88
	36	Scalar::Util = 0
	37	Sub::Exporter = 0
	38
	39	[Prereqs / TestRequires]
	40	Test::Fatal = 0.001
	41	Test::More = 0.88
	42
	43	[@Git]

+0

-78

~~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 = '0.91';
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->VERSION;
54		}
55
56		sub DESTROY {}
57
58		package Module::Install::Base::FakeAdmin;
59
60		my $fake;
61
62		sub new {
63		$fake \|\|= bless(\@_, $_[0]);
64		}
65
66		sub AUTOLOAD {}
67
68		sub DESTROY {}
69
70		# Restore warning handler
71		BEGIN {
72		$SIG{__WARN__} = $SIG{__WARN__}->();
73		}
74
75		1;
76
77		#line 154

+0

-81

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

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

+0

-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 = '0.91';
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;

+0

-268

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

+0

-624

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

+0

-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 = '0.91';
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;

+0

-60

~~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 = '0.91';;
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		$self->makemaker_args( PL_FILES => {} );
29		}
30
31		# Until ExtUtils::MakeMaker support MYMETA.yml, make sure
32		# we clean it up properly ourself.
33		$self->realclean_files('MYMETA.yml');
34
35		if ( $args{inline} ) {
36		$self->Inline->write;
37		} else {
38		$self->Makefile->write;
39		}
40
41		# The Makefile write process adds a couple of dependencies,
42		# so write the META.yml files after the Makefile.
43		if ( $args{meta} ) {
44		$self->Meta->write;
45		}
46
47		# Experimental support for MYMETA
48		if ( $ENV{X_MYMETA} ) {
49		if ( $ENV{X_MYMETA} eq 'JSON' ) {
50		$self->Meta->write_mymeta_json;
51		} else {
52		$self->Meta->write_mymeta_yaml;
53		}
54		}
55
56		return 1;
57		}
58
59		1;

+0

-430

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

+72

-39

lib/MooseX/Params/Validate.pm less more

0	0	package MooseX::Params::Validate;
	1	BEGIN {
	2	$MooseX::Params::Validate::VERSION = '0.15';
	3	}
	4	BEGIN {
	5	$MooseX::Params::Validate::AUTHORITY = 'cpan:STEVAN';
	6	}
1	7
2	8	use strict;
3	9	use warnings;

18	24	},
19	25	};
20	26
21		our $VERSION = '0.14';
22		our $AUTHORITY = 'cpan:STEVAN';
23
24	27	my %CACHED_SPECS;
25	28
26	29	sub validated_hash {
27	30	my ( $args, %spec ) = @_;
28	31
29	32	my $cache_key = _cache_key( \%spec );
	33
	34	my $allow_extra = delete $spec{MX_PARAMS_VALIDATE_ALLOW_EXTRA};
30	35
31	36	if ( exists $CACHED_SPECS{$cache_key} ) {
32	37	( ref $CACHED_SPECS{$cache_key} eq 'HASH' )

54	59	for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec;
55	60
56	61	%args = Params::Validate::validate_with(
57		params => \%args,
58		spec => \%spec,
59		called => _caller_name(),
	62	params => \%args,
	63	spec => \%spec,
	64	allow_extra => $allow_extra,
	65	called => _caller_name(),
60	66	);
61	67
62	68	return ( ( defined $instance ? $instance : () ), %args );

70	76	my %spec = @spec;
71	77
72	78	my $cache_key = _cache_key( \%spec );
	79
	80	my $allow_extra = delete $spec{MX_PARAMS_VALIDATE_ALLOW_EXTRA};
73	81
74	82	my @ordered_spec;
75	83	if ( exists $CACHED_SPECS{$cache_key} ) {

101	109	for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec;
102	110
103	111	%args = Params::Validate::validate_with(
104		params => \%args,
105		spec => \%spec,
106		called => _caller_name(),
	112	params => \%args,
	113	spec => \%spec,
	114	allow_extra => $allow_extra,
	115	called => _caller_name(),
107	116	);
108	117
109	118	return (

123	132	my %extra = @_;
124	133
125	134	my $cache_key = _cache_key( \%extra );
	135
	136	my $allow_extra = delete $extra{MX_PARAMS_VALIDATE_ALLOW_EXTRA};
126	137
127	138	my @pv_spec;
128	139	if ( exists $CACHED_SPECS{$cache_key} ) {

148	159	for grep { $pv_spec[$_] && $pv_spec[$_]{coerce} } 0 .. $#args;
149	160
150	161	@args = Params::Validate::validate_with(
151		params => \@args,
152		spec => \@pv_spec,
153		called => _caller_name(),
	162	params => \@args,
	163	spec => \@pv_spec,
	164	allow_extra => $allow_extra,
	165	called => _caller_name(),
154	166	);
155	167
156	168	return @args;

229	241
230	242	1;
231	243
232		__END__
	244	# ABSTRACT: an extension of Params::Validate using Moose's types
	245
	246
233	247
234	248	=pod
235	249
236	250	=head1 NAME
237	251
238		MooseX::Params::Validate - an extension of Params::Validate for using Moose's types
	252	MooseX::Params::Validate - an extension of Params::Validate using Moose's types
	253
	254	=head1 VERSION
	255
	256	version 0.15
239	257
240	258	=head1 SYNOPSIS
241	259

248	266	\@_,
249	267	bar => { isa => 'Str', default => 'Moose' },
250	268	);
251		return "Horray for $params{bar}!";
	269	return "Hooray for $params{bar}!";
252	270	}
253	271
254	272	sub bar {

269	287	be considered the "official" one by any means though.
270	288
271	289	You might also want to explore C<MooseX::Method::Signatures> and
272		C<MooseX::Declare>
	290	C<MooseX::Declare>.
273	291
274	292	=head1 CAVEATS
275	293
276		It is not possible to introspect the method parameter specs, they are
	294	It is not possible to introspect the method parameter specs; they are
277	295	created as needed when the method is called and cached for subsequent
278	296	calls.
279	297

283	301
284	302	=item B<validated_hash( \@_, %parameter_spec )>
285	303
286		This behaves similar to the standard Params::Validate C<validate>
	304	This behaves similarly to the standard Params::Validate C<validate>
287	305	function and returns the captured values in a HASH. The one exception
288		being that if it spots an instance in the C<@_>, then it will handle
	306	is where if it spots an instance in the C<@_>, then it will handle
289	307	it appropriately (unlike Params::Validate which forces you to shift
290	308	you C<$self> first).
291	309

388	406
389	407	=back
390	408
	409	=head1 ALLOWING EXTRA PARAMETERS
	410
	411	By default, any parameters not mentioned in the parameter spec cause this
	412	module to throw an error. However, you can have have this module simply ignore
	413	them by setting C<MX_PARAMS_VALIDATE_ALLOW_EXTRA> to a true value when calling
	414	a validation subroutine.
	415
	416	When calling C<validated_hash> or C<pos_validated_list> the extra parameters
	417	are simply returned in the hash or list as appropriate. However, when you call
	418	C<validated_list> the extra parameters will not be returned at all. You can
	419	get them by looking at the original value of C<@_>.
	420
391	421	=head1 EXPORTS
392	422
393	423	By default, this module exports the C<validated_hash>,

399	429
400	430	=head1 IMPORTANT NOTE ON CACHING
401	431
402		When C<validate> or C<validatep> are called the first time, the
403		parameter spec is prepared and cached to avoid unnecessary
404		regeneration. It uses the fully qualified name of the subroutine
405		(package + subname) as the cache key. In 99.999% of the use cases for
406		this module, that will be the right thing to do.
	432	When a validation subroutine is called the first time, the parameter spec is
	433	prepared and cached to avoid unnecessary regeneration. It uses the fully
	434	qualified name of the subroutine (package + subname) as the cache key. In
	435	99.999% of the use cases for this module, that will be the right thing to do.
407	436
408	437	However, I have (ab)used this module occasionally to handle dynamic
409	438	sets of parameters. In this special use case you can do a couple

441	470
442	471	=back
443	472
	473	=head1 MAINTAINER
	474
	475	Dave Rolsky E<lt>autarch@urth.orgE<gt>
	476
444	477	=head1 BUGS
445	478
446		All complex software has bugs lurking in it, and this module is no
447		exception. If you find a bug please either email me, or add the bug to
448		cpan-RT.
449
450		=head1 AUTHORS
451
452		Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
453
454		Dave Rolsky E<lt>autarch@urth.orgE<gt>
	479	Please submit bugs to the CPAN RT system at
	480	http://rt.cpan.org/NoAuth/ReportBug.html?Queue=moosex-params-validate or via
	481	email at bug-moosex-params-validate@rt.cpan.org.
	482
	483	=head1 AUTHOR
	484
	485	Stevan Little <stevan.little@iinteractive.com>
455	486
456	487	=head1 COPYRIGHT AND LICENSE
457	488
458		Copyright 2007-2009 by Infinity Interactive, Inc.
459
460		L<http://www.iinteractive.com>
461
462		This library is free software; you can redistribute it and/or modify
463		it under the same terms as Perl itself.
	489	This software is copyright (c) 2010 by Stevan Little <stevan.little@iinteractive.com>.
	490
	491	This is free software; you can redistribute it and/or modify it under
	492	the same terms as the Perl 5 programming language system itself.
464	493
465	494	=cut
	495
	496
	497	__END__
	498

+3

-1

t/000_load.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 1;
	5	use Test::More;
6	6
7	7	BEGIN {
8	8	# this module doesn't export to main
9	9	package Testing;
10	10	::use_ok('MooseX::Params::Validate');
11	11	}
	12
	13	done_testing();

+121

-69

t/001_basic.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 35;
6		use Test::Exception;
	5	use Test::More;
	6	use Test::Fatal;
7	7
8	8	{
9	9	package Roles::Blah;

44	44	my %params = validated_hash(
45	45	\@_,
46	46	foo => {
47		isa => subtype( 'Object' => where { $_->isa('Foo') } ),
	47	isa => subtype( 'Object' => where { $_->isa('Foo') } ),
48	48	optional => 1
49	49	},
50	50	bar => { does => 'Roles::Blah', optional => 1 },

76	76	isa_ok( $foo, 'Foo' );
77	77
78	78	is( $foo->foo, 'Horray for Moose!', '... got the right return value' );
79		is( $foo->foo( bar => 'Rolsky' ), 'Horray for Rolsky!',
80		'... got the right return value' );
	79	is(
	80	$foo->foo( bar => 'Rolsky' ), 'Horray for Rolsky!',
	81	'... got the right return value'
	82	);
81	83
82	84	is( $foo->baz( foo => $foo ), $foo, '... foo param must be a Foo instance' );
83	85
84		throws_ok { $foo->baz( foo => 10 ) } qr/\QThe 'foo' parameter ("10")/,
85		'... the foo param in &baz must be a Foo instance';
86		throws_ok { $foo->baz( foo => "foo" ) } qr/\QThe 'foo' parameter ("foo")/,
87		'... the foo param in &baz must be a Foo instance';
88		throws_ok { $foo->baz( foo => [] ) } qr/\QThe 'foo' parameter/,
89		'... the foo param in &baz must be a Foo instance';
	86	like(
	87	exception { $foo->baz( foo => 10 ) }, qr/\QThe 'foo' parameter ("10")/,
	88	'... the foo param in &baz must be a Foo instance'
	89	);
	90	like(
	91	exception { $foo->baz( foo => "foo" ) },
	92	qr/\QThe 'foo' parameter ("foo")/,
	93	'... the foo param in &baz must be a Foo instance'
	94	);
	95	like(
	96	exception { $foo->baz( foo => [] ) }, qr/\QThe 'foo' parameter/,
	97	'... the foo param in &baz must be a Foo instance'
	98	);
90	99
91	100	is( $foo->baz( bar => $foo ), $foo, '... bar param must do Roles::Blah' );
92	101
93		throws_ok { $foo->baz( bar => 10 ) } qr/\QThe 'bar' parameter ("10")/,
94		'... the bar param in &baz must be do Roles::Blah';
95		throws_ok { $foo->baz( bar => "foo" ) } qr/\QThe 'bar' parameter ("foo")/,
96		'... the bar param in &baz must be do Roles::Blah';
97		throws_ok { $foo->baz( bar => [] ) } qr/\QThe 'bar' parameter/,
98		'... the bar param in &baz must be do Roles::Blah';
	102	like(
	103	exception { $foo->baz( bar => 10 ) }, qr/\QThe 'bar' parameter ("10")/,
	104	'... the bar param in &baz must be do Roles::Blah'
	105	);
	106	like(
	107	exception { $foo->baz( bar => "foo" ) },
	108	qr/\QThe 'bar' parameter ("foo")/,
	109	'... the bar param in &baz must be do Roles::Blah'
	110	);
	111	like(
	112	exception { $foo->baz( bar => [] ) }, qr/\QThe 'bar' parameter/,
	113	'... the bar param in &baz must be do Roles::Blah'
	114	);
99	115
100	116	is( $foo->baz( boo => $foo ), $foo, '... boo param must do Roles::Blah' );
101	117
102		throws_ok { $foo->baz( boo => 10 ) } qr/\QThe 'boo' parameter ("10")/,
103		'... the boo param in &baz must be do Roles::Blah';
104		throws_ok { $foo->baz( boo => "foo" ) } qr/\QThe 'boo' parameter ("foo")/,
105		'... the boo param in &baz must be do Roles::Blah';
106		throws_ok { $foo->baz( boo => [] ) } qr/\QThe 'boo' parameter/,
107		'... the boo param in &baz must be do Roles::Blah';
108
109		throws_ok { $foo->bar } qr/\QMandatory parameter 'foo'/,
110		'... bar has a required param';
111		throws_ok { $foo->bar( foo => 10 ) } qr/\QThe 'foo' parameter ("10")/,
112		'... the foo param in &bar must be a Foo instance';
113		throws_ok { $foo->bar( foo => "foo" ) } qr/\QThe 'foo' parameter ("foo")/,
114		'... the foo param in &bar must be a Foo instance';
115		throws_ok { $foo->bar( foo => [] ) } qr/\QThe 'foo' parameter/,
116		'... the foo param in &bar must be a Foo instance';
117		throws_ok { $foo->bar( baz => [] ) } qr/\QMandatory parameter 'foo'/,,
118		'... bar has a required foo param';
	118	like(
	119	exception { $foo->baz( boo => 10 ) }, qr/\QThe 'boo' parameter ("10")/,
	120	'... the boo param in &baz must be do Roles::Blah'
	121	);
	122	like(
	123	exception { $foo->baz( boo => "foo" ) },
	124	qr/\QThe 'boo' parameter ("foo")/,
	125	'... the boo param in &baz must be do Roles::Blah'
	126	);
	127	like(
	128	exception { $foo->baz( boo => [] ) }, qr/\QThe 'boo' parameter/,
	129	'... the boo param in &baz must be do Roles::Blah'
	130	);
	131
	132	like(
	133	exception { $foo->bar }, qr/\QMandatory parameter 'foo'/,
	134	'... bar has a required param'
	135	);
	136	like(
	137	exception { $foo->bar( foo => 10 ) }, qr/\QThe 'foo' parameter ("10")/,
	138	'... the foo param in &bar must be a Foo instance'
	139	);
	140	like(
	141	exception { $foo->bar( foo => "foo" ) },
	142	qr/\QThe 'foo' parameter ("foo")/,
	143	'... the foo param in &bar must be a Foo instance'
	144	);
	145	like(
	146	exception { $foo->bar( foo => [] ) }, qr/\QThe 'foo' parameter/,
	147	'... the foo param in &bar must be a Foo instance'
	148	);
	149	like( exception { $foo->bar( baz => [] ) }, qr/\QMandatory parameter 'foo'/ );
119	150
120	151	is_deeply(
121	152	$foo->bar( foo => $foo ),

135	166	'... the foo param and baz param in &bar got a correct args'
136	167	);
137	168
138		throws_ok { $foo->bar( foo => $foo, baz => undef ) }
139		qr/\QThe 'baz' parameter (undef)/,
140		'... baz requires a ArrayRef \| HashRef';
141		throws_ok { $foo->bar( foo => $foo, baz => 10 ) }
142		qr/\QThe 'baz' parameter ("10")/,
143		'... baz requires a ArrayRef \| HashRef';
144		throws_ok { $foo->bar( foo => $foo, baz => 'Foo' ) }
145		qr/\QThe 'baz' parameter ("Foo")/,
146		'... baz requires a ArrayRef \| HashRef';
147		throws_ok { $foo->bar( foo => $foo, baz => \( my $var ) ) }
148		qr/\QThe 'baz' parameter/,
149		'... baz requires a ArrayRef \| HashRef';
	169	like(
	170	exception { $foo->bar( foo => $foo, baz => undef ) },
	171	qr/\QThe 'baz' parameter (undef)/,
	172	'... baz requires a ArrayRef \| HashRef'
	173	);
	174	like(
	175	exception { $foo->bar( foo => $foo, baz => 10 ) },
	176	qr/\QThe 'baz' parameter ("10")/,
	177	'... baz requires a ArrayRef \| HashRef'
	178	);
	179	like(
	180	exception { $foo->bar( foo => $foo, baz => 'Foo' ) },
	181	qr/\QThe 'baz' parameter ("Foo")/,
	182	'... baz requires a ArrayRef \| HashRef'
	183	);
	184	like(
	185	exception { $foo->bar( foo => $foo, baz => \( my $var ) ) },
	186	qr/\QThe 'baz' parameter/, '... baz requires a ArrayRef \| HashRef'
	187	);
150	188
151	189	is_deeply(
152	190	$foo->bar( foo => $foo, gorch => [ 1, 2, 3 ] ),

154	192	'... the foo param in &bar got a Foo instance'
155	193	);
156	194
157		throws_ok { $foo->bar( foo => $foo, gorch => undef ) }
158		qr/\QThe 'gorch' parameter (undef)/,
159		'... gorch requires a ArrayRef[Int]';
160		throws_ok { $foo->bar( foo => $foo, gorch => 10 ) }
161		qr/\QThe 'gorch' parameter ("10")/,
162		'... gorch requires a ArrayRef[Int]';
163		throws_ok { $foo->bar( foo => $foo, gorch => 'Foo' ) }
164		qr/\QThe 'gorch' parameter ("Foo")/,
165		'... gorch requires a ArrayRef[Int]';
166		throws_ok { $foo->bar( foo => $foo, gorch => \( my $var ) ) }
167		qr/\QThe 'gorch' parameter/,
168		'... gorch requires a ArrayRef[Int]';
169		throws_ok { $foo->bar( foo => $foo, gorch => [qw/one two three/] ) }
170		qr/\QThe 'gorch' parameter/,
171		'... gorch requires a ArrayRef[Int]';
172
173		throws_ok { $foo->quux( foo => '123456790' ) }
174		qr/\QThe 'foo' parameter\E.+\Qchecking type constraint/,
175		'... foo parameter must be an ArrayRef';
176
177		throws_ok { $foo->quux( foo => [ 1, 2, 3, 4 ] ) }
178		qr/\QThe 'foo' parameter\E.+\Qsome random callback/,
179		'... foo parameter additional callback requires that arrayref be 0-2 elements';
	195	like(
	196	exception { $foo->bar( foo => $foo, gorch => undef ) },
	197	qr/\QThe 'gorch' parameter (undef)/,
	198	'... gorch requires a ArrayRef[Int]'
	199	);
	200	like(
	201	exception { $foo->bar( foo => $foo, gorch => 10 ) },
	202	qr/\QThe 'gorch' parameter ("10")/,
	203	'... gorch requires a ArrayRef[Int]'
	204	);
	205	like(
	206	exception { $foo->bar( foo => $foo, gorch => 'Foo' ) },
	207	qr/\QThe 'gorch' parameter ("Foo")/,
	208	'... gorch requires a ArrayRef[Int]'
	209	);
	210	like(
	211	exception { $foo->bar( foo => $foo, gorch => \( my $var ) ) },
	212	qr/\QThe 'gorch' parameter/, '... gorch requires a ArrayRef[Int]'
	213	);
	214	like(
	215	exception { $foo->bar( foo => $foo, gorch => [qw/one two three/] ) },
	216	qr/\QThe 'gorch' parameter/, '... gorch requires a ArrayRef[Int]'
	217	);
	218
	219	like(
	220	exception { $foo->quux( foo => '123456790' ) },
	221	qr/\QThe 'foo' parameter\E.+\Qchecking type constraint/,
	222	'... foo parameter must be an ArrayRef'
	223	);
	224
	225	like(
	226	exception { $foo->quux( foo => [ 1, 2, 3, 4 ] ) },
	227	qr/\QThe 'foo' parameter\E.+\Qsome random callback/,
	228	'... foo parameter additional callback requires that arrayref be 0-2 elements'
	229	);
	230
	231	done_testing();

+85

-45

t/002_basic_list.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 27;
6		use Test::Exception;
	5	use Test::More;
	6	use Test::Fatal;
7	7
8	8	{
9	9	package Roles::Blah;

43	43	my ( $foo, $bar, $boo ) = validated_list(
44	44	\@_,
45	45	foo => {
46		isa => subtype( 'Object' => where { $_->isa('Foo') } ),
	46	isa => subtype( 'Object' => where { $_->isa('Foo') } ),
47	47	optional => 1
48	48	},
49	49	bar => { does => 'Roles::Blah', optional => 1 },

60	60	isa_ok( $foo, 'Foo' );
61	61
62	62	is( $foo->foo, 'Horray for Moose!', '... got the right return value' );
63		is( $foo->foo( bar => 'Rolsky' ), 'Horray for Rolsky!',
64		'... got the right return value' );
	63	is(
	64	$foo->foo( bar => 'Rolsky' ), 'Horray for Rolsky!',
	65	'... got the right return value'
	66	);
65	67
66	68	is( $foo->baz( foo => $foo ), $foo, '... foo param must be a Foo instance' );
67	69
68		throws_ok { $foo->baz( foo => 10 ) } qr/\QThe 'foo' parameter ("10")/,
69		'... the foo param in &baz must be a Foo instance';
70		throws_ok { $foo->baz( foo => "foo" ) } qr/\QThe 'foo' parameter ("foo")/,
71		'... the foo param in &baz must be a Foo instance';
72		throws_ok { $foo->baz( foo => [] ) } qr/\QThe 'foo' parameter/,
73		'... the foo param in &baz must be a Foo instance';
	70	like(
	71	exception { $foo->baz( foo => 10 ) }, qr/\QThe 'foo' parameter ("10")/,
	72	'... the foo param in &baz must be a Foo instance'
	73	);
	74	like(
	75	exception { $foo->baz( foo => "foo" ) },
	76	qr/\QThe 'foo' parameter ("foo")/,
	77	'... the foo param in &baz must be a Foo instance'
	78	);
	79	like(
	80	exception { $foo->baz( foo => [] ) }, qr/\QThe 'foo' parameter/,
	81	'... the foo param in &baz must be a Foo instance'
	82	);
74	83
75	84	is( $foo->baz( bar => $foo ), $foo, '... bar param must do Roles::Blah' );
76	85
77		throws_ok { $foo->baz( bar => 10 ) } qr/\QThe 'bar' parameter ("10")/,
78		'... the bar param in &baz must be do Roles::Blah';
79		throws_ok { $foo->baz( bar => "foo" ) } qr/\QThe 'bar' parameter ("foo")/,
80		'... the bar param in &baz must be do Roles::Blah';
81		throws_ok { $foo->baz( bar => [] ) } qr/\QThe 'bar' parameter/,
82		'... the bar param in &baz must be do Roles::Blah';
	86	like(
	87	exception { $foo->baz( bar => 10 ) }, qr/\QThe 'bar' parameter ("10")/,
	88	'... the bar param in &baz must be do Roles::Blah'
	89	);
	90	like(
	91	exception { $foo->baz( bar => "foo" ) },
	92	qr/\QThe 'bar' parameter ("foo")/,
	93	'... the bar param in &baz must be do Roles::Blah'
	94	);
	95	like(
	96	exception { $foo->baz( bar => [] ) }, qr/\QThe 'bar' parameter/,
	97	'... the bar param in &baz must be do Roles::Blah'
	98	);
83	99
84	100	is( $foo->baz( boo => $foo ), $foo, '... boo param must do Roles::Blah' );
85	101
86		throws_ok { $foo->baz( boo => 10 ) } qr/\QThe 'boo' parameter ("10")/,
87		'... the boo param in &baz must be do Roles::Blah';
88		throws_ok { $foo->baz( boo => "foo" ) } qr/\QThe 'boo' parameter ("foo")/,
89		'... the boo param in &baz must be do Roles::Blah';
90		throws_ok { $foo->baz( boo => [] ) } qr/\QThe 'boo' parameter/,
91		'... the boo param in &baz must be do Roles::Blah';
	102	like(
	103	exception { $foo->baz( boo => 10 ) }, qr/\QThe 'boo' parameter ("10")/,
	104	'... the boo param in &baz must be do Roles::Blah'
	105	);
	106	like(
	107	exception { $foo->baz( boo => "foo" ) },
	108	qr/\QThe 'boo' parameter ("foo")/,
	109	'... the boo param in &baz must be do Roles::Blah'
	110	);
	111	like(
	112	exception { $foo->baz( boo => [] ) }, qr/\QThe 'boo' parameter/,
	113	'... the boo param in &baz must be do Roles::Blah'
	114	);
92	115
93		throws_ok { $foo->bar } qr/\QMandatory parameter 'foo'/,
94		'... bar has a required param';
95		throws_ok { $foo->bar( foo => 10 ) } qr/\QThe 'foo' parameter ("10")/,
96		'... the foo param in &bar must be a Foo instance';
97		throws_ok { $foo->bar( foo => "foo" ) } qr/\QThe 'foo' parameter ("foo")/,
98		'... the foo param in &bar must be a Foo instance';
99		throws_ok { $foo->bar( foo => [] ) } qr/\QThe 'foo' parameter/,
100		'... the foo param in &bar must be a Foo instance';
101		throws_ok { $foo->bar( baz => [] ) } qr/\QMandatory parameter 'foo'/,,
102		'... bar has a required foo param';
	116	like(
	117	exception { $foo->bar }, qr/\QMandatory parameter 'foo'/,
	118	'... bar has a required param'
	119	);
	120	like(
	121	exception { $foo->bar( foo => 10 ) }, qr/\QThe 'foo' parameter ("10")/,
	122	'... the foo param in &bar must be a Foo instance'
	123	);
	124	like(
	125	exception { $foo->bar( foo => "foo" ) },
	126	qr/\QThe 'foo' parameter ("foo")/,
	127	'... the foo param in &bar must be a Foo instance'
	128	);
	129	like(
	130	exception { $foo->bar( foo => [] ) }, qr/\QThe 'foo' parameter/,
	131	'... the foo param in &bar must be a Foo instance'
	132	);
	133	like( exception { $foo->bar( baz => [] ) }, qr/\QMandatory parameter 'foo'/ );
103	134
104	135	is_deeply(
105	136	$foo->bar( foo => $foo ),

119	150	'... the foo param and baz param in &bar got a correct args'
120	151	);
121	152
122		throws_ok { $foo->bar( foo => $foo, baz => undef ) }
123		qr/\QThe 'baz' parameter (undef)/,
124		'... baz requires a ArrayRef \| HashRef';
125		throws_ok { $foo->bar( foo => $foo, baz => 10 ) }
126		qr/\QThe 'baz' parameter ("10")/,
127		'... baz requires a ArrayRef \| HashRef';
128		throws_ok { $foo->bar( foo => $foo, baz => 'Foo' ) }
129		qr/\QThe 'baz' parameter ("Foo")/,
130		'... baz requires a ArrayRef \| HashRef';
131		throws_ok { $foo->bar( foo => $foo, baz => \( my $var ) ) }
132		qr/\QThe 'baz' parameter/,
133		'... baz requires a ArrayRef \| HashRef';
	153	like(
	154	exception { $foo->bar( foo => $foo, baz => undef ) },
	155	qr/\QThe 'baz' parameter (undef)/,
	156	'... baz requires a ArrayRef \| HashRef'
	157	);
	158	like(
	159	exception { $foo->bar( foo => $foo, baz => 10 ) },
	160	qr/\QThe 'baz' parameter ("10")/,
	161	'... baz requires a ArrayRef \| HashRef'
	162	);
	163	like(
	164	exception { $foo->bar( foo => $foo, baz => 'Foo' ) },
	165	qr/\QThe 'baz' parameter ("Foo")/,
	166	'... baz requires a ArrayRef \| HashRef'
	167	);
	168	like(
	169	exception { $foo->bar( foo => $foo, baz => \( my $var ) ) },
	170	qr/\QThe 'baz' parameter/, '... baz requires a ArrayRef \| HashRef'
	171	);
	172
	173	done_testing();

+24

-14

t/003_nocache_flag.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 4;
6		use Test::Exception;
	5	use Test::More;
	6	use Test::Fatal;
7	7
8	8	{
9	9	package Foo;

20	20	my $foo = Foo->new;
21	21	isa_ok( $foo, 'Foo' );
22	22
23		lives_ok {
24		$foo->bar( [ baz => 1 ], { baz => { isa => 'Int' } } );
25		}
26		'... successfully applied the parameter validation';
	23	is(
	24	exception {
	25	$foo->bar( [ baz => 1 ], { baz => { isa => 'Int' } } );
	26	},
	27	undef,
	28	'... successfully applied the parameter validation'
	29	);
27	30
28		lives_ok {
29		$foo->bar( [ baz => [ 1, 2, 3 ] ], { baz => { isa => 'ArrayRef' } } );
30		}
31		'... successfully applied the parameter validation (look mah no cache)';
	31	is(
	32	exception {
	33	$foo->bar( [ baz => [ 1, 2, 3 ] ], { baz => { isa => 'ArrayRef' } } );
	34	},
	35	undef,
	36	'... successfully applied the parameter validation (look mah no cache)'
	37	);
32	38
33		lives_ok {
34		$foo->bar( [ baz => { one => 1 } ], { baz => { isa => 'HashRef' } } );
35		}
36		'... successfully applied the parameter validation (look mah no cache) (just checkin)';
	39	is(
	40	exception {
	41	$foo->bar( [ baz => { one => 1 } ], { baz => { isa => 'HashRef' } } );
	42	},
	43	undef,
	44	'... successfully applied the parameter validation (look mah no cache) (just checkin)'
	45	);
37	46
	47	done_testing();

+41

-22

t/004_custom_cache_key.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 7;
6		use Test::Exception;
	5	use Test::More;
	6	use Test::Fatal;
7	7	use Scalar::Util;
8	8
9	9	{

22	22	my $foo = Foo->new;
23	23	isa_ok( $foo, 'Foo' );
24	24
25		lives_ok {
26		$foo->bar( [ baz => 1 ], { baz => { isa => 'Int' } } );
27		}
28		'... successfully applied the parameter validation';
	25	is(
	26	exception {
	27	$foo->bar( [ baz => 1 ], { baz => { isa => 'Int' } } );
	28	},
	29	undef,
	30	'... successfully applied the parameter validation'
	31	);
29	32
30		throws_ok {
31		$foo->bar( [ baz => [ 1, 2, 3 ] ], { baz => { isa => 'ArrayRef' } } );
32		} qr/\QThe 'baz' parameter/,
33		'... successfully re-used the parameter validation for this instance';
	33	like(
	34	exception {
	35	$foo->bar( [ baz => [ 1, 2, 3 ] ], { baz => { isa => 'ArrayRef' } } );
	36	},
	37	qr/\QThe 'baz' parameter/,
	38	'... successfully re-used the parameter validation for this instance'
	39	);
34	40
35	41	my $foo2 = Foo->new;
36	42	isa_ok( $foo2, 'Foo' );
37	43
38		lives_ok {
39		$foo2->bar( [ baz => [ 1, 2, 3 ] ], { baz => { isa => 'ArrayRef' } } );
40		}
41		'... successfully applied the parameter validation';
	44	is(
	45	exception {
	46	$foo2->bar(
	47	[ baz => [ 1, 2, 3 ] ],
	48	{ baz => { isa => 'ArrayRef' } }
	49	);
	50	},
	51	undef,
	52	'... successfully applied the parameter validation'
	53	);
42	54
43		throws_ok {
44		$foo2->bar( [ baz => 1 ], { baz => { isa => 'Int' } } );
45		} qr/\QThe 'baz' parameter/,
46		'... successfully re-used the parameter validation for this instance';
	55	like(
	56	exception {
	57	$foo2->bar( [ baz => 1 ], { baz => { isa => 'Int' } } );
	58	},
	59	qr/\QThe 'baz' parameter/,
	60	'... successfully re-used the parameter validation for this instance'
	61	);
47	62
48		lives_ok {
49		$foo->bar( [ baz => 1 ], { baz => { isa => 'Int' } } );
50		}
51		'... successfully applied the parameter validation (just checking)';
	63	is(
	64	exception {
	65	$foo->bar( [ baz => 1 ], { baz => { isa => 'Int' } } );
	66	},
	67	undef,
	68	'... successfully applied the parameter validation (just checking)'
	69	);
52	70
	71	done_testing();

+25

-21

t/005_coercion.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 15;
6		use Test::Exception;
	5	use Test::More;
	6	use Test::Fatal;
7	7
8	8	# Note that setting coerce => 1 for the Num type tests that we don't try to do
9	9	# coercions for a type which doesn't have any coercions.

30	30
31	31	# added to test 'optional' on validated_hash
32	32	sub baropt {
33		my $self = shift;
	33	my $self = shift;
34	34	my %params = validated_hash(
35	35	\@_,
36	36	size1 => { isa => 'Size', coerce => 1, optional => 1 },

39	39	);
40	40	[ $params{size1}, $params{size2}, $params{number} ];
41	41	}
42
43	42
44	43	sub baz {
45	44	my $self = shift;

51	50	);
52	51	[ $size1, $size2, $number ];
53	52	}
54
55	53
56	54	sub quux {
57	55	my $self = shift;

91	89	'got the return value right with coercions for size1'
92	90	);
93	91
94		throws_ok { $foo->bar( size1 => 30, size2 => [ 1, 2, 3 ], number => 30 ) }
95		qr/\QThe 'size2' parameter/,
96		'... the size2 param cannot be coerced';
	92	like(
	93	exception { $foo->bar( size1 => 30, size2 => [ 1, 2, 3 ], number => 30 ) }
	94	, qr/\QThe 'size2' parameter/, '... the size2 param cannot be coerced' );
97	95
98		throws_ok { $foo->bar( size1 => 30, size2 => 10, number => 'something' ) }
99		qr/\QThe 'number' parameter/,
100		'... the number param cannot be coerced because there is no coercion defined for Num';
	96	like(
	97	exception { $foo->bar( size1 => 30, size2 => 10, number => 'something' ) }
	98	, qr/\QThe 'number' parameter/,
	99	'... the number param cannot be coerced because there is no coercion defined for Num'
	100	);
101	101
102	102	is_deeply(
103	103	$foo->baz( size1 => 10, size2 => 20, number => 30 ),

111	111	'got the return value right with coercions for size1'
112	112	);
113	113
114		throws_ok { $foo->baz( size1 => 30, size2 => [ 1, 2, 3 ], number => 30 ) }
115		qr/\QThe 'size2' parameter/,
116		'... the size2 param cannot be coerced';
	114	like(
	115	exception { $foo->baz( size1 => 30, size2 => [ 1, 2, 3 ], number => 30 ) }
	116	, qr/\QThe 'size2' parameter/, '... the size2 param cannot be coerced' );
117	117
118		throws_ok { $foo->baz( size1 => 30, size2 => 10, number => 'something' ) }
119		qr/\QThe 'number' parameter/,
120		'... the number param cannot be coerced';
	118	like(
	119	exception { $foo->baz( size1 => 30, size2 => 10, number => 'something' ) }
	120	, qr/\QThe 'number' parameter/,
	121	'... the number param cannot be coerced'
	122	);
121	123
122	124	is_deeply(
123	125	$foo->baropt( size2 => 4 ),

143	145	'got the return value right with coercion for the first param'
144	146	);
145	147
146		throws_ok { $foo->ran_out( [ 1, 2 ], [ 1, 2 ] ) }
147		qr/\QParameter #2/,
148		'... did not attempt to coerce the second parameter';
149
	148	like(
	149	exception { $foo->ran_out( [ 1, 2 ], [ 1, 2 ] ) }, qr/\QParameter #2/,
	150	'... did not attempt to coerce the second parameter'
	151	);
150	152
151	153	is_deeply(
152	154	$foo->ran_out(),
153	155	[ undef, undef, undef ],
154	156	'did not try to coerce non-existent parameters'
155	157	);
	158
	159	done_testing();

+7

-3

t/006_not_moose.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 2;
6		use Test::Exception;
	5	use Test::More;
7	6
8	7	eval <<'EOF';
9	8	{

16	15	$@, '',
17	16	'loading MX::Params::Validate in a non-Moose class does not blow up'
18	17	);
19		ok( Foo->can('validated_hash'), 'validated_hash() sub was added to Foo package' );
	18	ok(
	19	Foo->can('validated_hash'),
	20	'validated_hash() sub was added to Foo package'
	21	);
	22
	23	done_testing();

+3

-3

t/007_deprecated.t less more

0	0	use strict;
1	1	use warnings;
2	2
3		use Test::More tests => 2;
4		use Test::Exception;
	3	use Test::More;
5	4
6	5	{
7	6	package Foo;
8	7
9	8	use Moose;
10	9	use MooseX::Params::Validate qw( :deprecated );
11
12	10	}
13	11
14	12	ok( Foo->can('validate'), ':deprecated tag exports validate' );
15	13	ok( Foo->can('validatep'), ':deprecated tag exports validatep' );
	14
	15	done_testing();

+111

-60

t/008_positional.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 31;
6		use Test::Exception;
	5	use Test::More;
	6	use Test::Fatal;
7	7
8	8	{
9	9	package Roles::Blah;

44	44	my $self = shift;
45	45	return [
46	46	pos_validated_list(
47		\@_,
48		{
	47	\@_, {
49	48	isa => subtype( 'Object' => where { $_->isa('Foo') } ),
50	49	optional => 1
51	50	},

64	63
65	64	is( $foo->baz($foo)->[0], $foo, '... first param must be a Foo instance' );
66	65
67		throws_ok { $foo->baz(10) } qr/\QParameter #1 ("10")/,
68		'... the first param in &baz must be a Foo instance';
69		throws_ok { $foo->baz('foo') } qr/\QParameter #1 ("foo")/,
70		'... the first param in &baz must be a Foo instance';
71		throws_ok { $foo->baz( [] ) } qr/\QParameter #1/,
72		'... the first param in &baz must be a Foo instance';
73
74		is( $foo->baz( $foo, $foo )->[1], $foo,
75		'... second param must do Roles::Blah' );
76
77		throws_ok { $foo->baz( $foo, 10 ) } qr/\QParameter #2 ("10")/,
78		'... the second param in &baz must be do Roles::Blah';
79		throws_ok { $foo->baz( $foo, 'foo' ) } qr/\QParameter #2 ("foo")/,
80		'... the second param in &baz must be do Roles::Blah';
81		throws_ok { $foo->baz( $foo, [] ) } qr/\QParameter #2/,
82		'... the second param in &baz must be do Roles::Blah';
83
84		is( $foo->baz( $foo, $foo, $foo )->[2], $foo,
85		'... third param must do Roles::Blah' );
86
87		throws_ok { $foo->baz( $foo, $foo, 10 ) } qr/\QParameter #3 ("10")/,
88		'... the third param in &baz must be do Roles::Blah';
89		throws_ok { $foo->baz( $foo, $foo, "foo" ) } qr/\QParameter #3 ("foo")/,
90		'... the third param in &baz must be do Roles::Blah';
91		throws_ok { $foo->baz( $foo, $foo, [] ) } qr/\QParameter #3/,
92		'... the third param in &baz must be do Roles::Blah';
93
94		throws_ok { $foo->bar } qr/\Q0 parameters were passed/,
95		'... bar has a required params';
96		throws_ok { $foo->bar(10) } qr/\QParameter #1 ("10")/,
97		'... the first param in &bar must be a Foo instance';
98		throws_ok { $foo->bar('foo') } qr/\QParameter #1 ("foo")/,
99		'... the first param in &bar must be a Foo instance';
100		throws_ok { $foo->bar( [] ) } qr/\QParameter #1/,
101		'... the first param in &bar must be a Foo instance';
102		throws_ok { $foo->bar() } qr/\Q0 parameters were passed/,
103		'... bar has a required first param';
	66	like(
	67	exception { $foo->baz(10) }, qr/\QParameter #1 ("10")/,
	68	'... the first param in &baz must be a Foo instance'
	69	);
	70	like(
	71	exception { $foo->baz('foo') }, qr/\QParameter #1 ("foo")/,
	72	'... the first param in &baz must be a Foo instance'
	73	);
	74	like(
	75	exception { $foo->baz( [] ) }, qr/\QParameter #1/,
	76	'... the first param in &baz must be a Foo instance'
	77	);
	78
	79	is(
	80	$foo->baz( $foo, $foo )->[1], $foo,
	81	'... second param must do Roles::Blah'
	82	);
	83
	84	like(
	85	exception { $foo->baz( $foo, 10 ) }, qr/\QParameter #2 ("10")/,
	86	'... the second param in &baz must be do Roles::Blah'
	87	);
	88	like(
	89	exception { $foo->baz( $foo, 'foo' ) }, qr/\QParameter #2 ("foo")/,
	90	'... the second param in &baz must be do Roles::Blah'
	91	);
	92	like(
	93	exception { $foo->baz( $foo, [] ) }, qr/\QParameter #2/,
	94	'... the second param in &baz must be do Roles::Blah'
	95	);
	96
	97	is(
	98	$foo->baz( $foo, $foo, $foo )->[2], $foo,
	99	'... third param must do Roles::Blah'
	100	);
	101
	102	like(
	103	exception { $foo->baz( $foo, $foo, 10 ) }, qr/\QParameter #3 ("10")/,
	104	'... the third param in &baz must be do Roles::Blah'
	105	);
	106	like(
	107	exception { $foo->baz( $foo, $foo, "foo" ) },
	108	qr/\QParameter #3 ("foo")/,
	109	'... the third param in &baz must be do Roles::Blah'
	110	);
	111	like(
	112	exception { $foo->baz( $foo, $foo, [] ) }, qr/\QParameter #3/,
	113	'... the third param in &baz must be do Roles::Blah'
	114	);
	115
	116	like(
	117	exception { $foo->bar }, qr/\Q0 parameters were passed/,
	118	'... bar has a required params'
	119	);
	120	like(
	121	exception { $foo->bar(10) }, qr/\QParameter #1 ("10")/,
	122	'... the first param in &bar must be a Foo instance'
	123	);
	124	like(
	125	exception { $foo->bar('foo') }, qr/\QParameter #1 ("foo")/,
	126	'... the first param in &bar must be a Foo instance'
	127	);
	128	like(
	129	exception { $foo->bar( [] ) }, qr/\QParameter #1/,
	130	'... the first param in &bar must be a Foo instance'
	131	);
	132	like(
	133	exception { $foo->bar() }, qr/\Q0 parameters were passed/,
	134	'... bar has a required first param'
	135	);
104	136
105	137	is_deeply(
106	138	$foo->bar($foo),

120	152	'... the first param and baz param in &bar got correct args'
121	153	);
122	154
123		throws_ok { $foo->bar( $foo, undef ) } qr/\QParameter #2 (undef)/,
124		'... second param requires a ArrayRef \| HashRef';
125		throws_ok { $foo->bar( $foo, 10 ) } qr/\QParameter #2 ("10")/,
126		'... second param requires a ArrayRef \| HashRef';
127		throws_ok { $foo->bar( $foo, 'Foo' ) } qr/\QParameter #2 ("Foo")/,
128		'... second param requires a ArrayRef \| HashRef';
129		throws_ok { $foo->bar( $foo, \( my $var ) ) } qr/\QParameter #2/,
130		'... second param requires a ArrayRef \| HashRef';
	155	like(
	156	exception { $foo->bar( $foo, undef ) }, qr/\QParameter #2 (undef)/,
	157	'... second param requires a ArrayRef \| HashRef'
	158	);
	159	like(
	160	exception { $foo->bar( $foo, 10 ) }, qr/\QParameter #2 ("10")/,
	161	'... second param requires a ArrayRef \| HashRef'
	162	);
	163	like(
	164	exception { $foo->bar( $foo, 'Foo' ) }, qr/\QParameter #2 ("Foo")/,
	165	'... second param requires a ArrayRef \| HashRef'
	166	);
	167	like(
	168	exception { $foo->bar( $foo, \( my $var ) ) }, qr/\QParameter #2/,
	169	'... second param requires a ArrayRef \| HashRef'
	170	);
131	171
132	172	is_deeply(
133	173	$foo->bar( $foo, {}, [ 1, 2, 3 ] ),

135	175	'... the first param in &bar got a Foo instance'
136	176	);
137	177
138		throws_ok { $foo->bar( $foo, {}, undef ) } qr/\QParameter #3 (undef)/,
139		'... third param a ArrayRef[Int]';
140		throws_ok { $foo->bar( $foo, {}, 10 ) } qr/\QParameter #3 ("10")/,
141		'... third param a ArrayRef[Int]';
142		throws_ok { $foo->bar( $foo, {}, 'Foo' ) } qr/\QParameter #3 ("Foo")/,
143		'... third param a ArrayRef[Int]';
144		throws_ok { $foo->bar( $foo, {}, \( my $var ) ) } qr/\QParameter #3/,
145		'... third param a ArrayRef[Int]';
146		throws_ok { $foo->bar( $foo, {}, [qw/one two three/] ) } qr/\QParameter #3/,
147		'... third param a ArrayRef[Int]';
148
	178	like(
	179	exception { $foo->bar( $foo, {}, undef ) }, qr/\QParameter #3 (undef)/,
	180	'... third param a ArrayRef[Int]'
	181	);
	182	like(
	183	exception { $foo->bar( $foo, {}, 10 ) }, qr/\QParameter #3 ("10")/,
	184	'... third param a ArrayRef[Int]'
	185	);
	186	like(
	187	exception { $foo->bar( $foo, {}, 'Foo' ) }, qr/\QParameter #3 ("Foo")/,
	188	'... third param a ArrayRef[Int]'
	189	);
	190	like(
	191	exception { $foo->bar( $foo, {}, \( my $var ) ) }, qr/\QParameter #3/,
	192	'... third param a ArrayRef[Int]'
	193	);
	194	like(
	195	exception { $foo->bar( $foo, {}, [qw/one two three/] ) },
	196	qr/\QParameter #3/, '... third param a ArrayRef[Int]'
	197	);
	198
	199	done_testing();

+20

-15

t/009_wrapped.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 2;
6		use Test::Exception;
	5	use Test::More;
	6	use Test::Fatal;
7	7
8	8	{
9	9	package Foo;

14	14	my $self = shift;
15	15	my %params = validated_hash(
16	16	\@_,
17		foo => { isa => 'Str' },
	17	foo => { isa => 'Str' },
18	18	);
19	19	return $params{foo};
20	20	}

27	27	my @args = ( bar => delete $p{bar} );
28	28
29	29	my %params = validated_hash(
30		\@args,
31		bar => { isa => 'Str' },
32		);
	30	\@args,
	31	bar => { isa => 'Str' },
	32	);
33	33
34	34	$params{bar}, $self->$orig(%p);
35	35	};

42	42	my @args = ( quux => delete $p{quux} );
43	43
44	44	my %params = validated_hash(
45		\@args,
46		quux => { isa => 'Str' },
47		);
	45	\@args,
	46	quux => { isa => 'Str' },
	47	);
48	48
49	49	$params{quux}, $self->$orig(%p);
50	50	};

53	53	{
54	54	my $foo = Foo->new;
55	55
56		is_deeply( [ $foo->foo( foo => 1, bar => 2, quux => 3 ) ],
57		[ 3, 2, 1 ],
58		'multiple around wrappers can safely be cached' );
	56	is_deeply(
	57	[ $foo->foo( foo => 1, bar => 2, quux => 3 ) ],
	58	[ 3, 2, 1 ],
	59	'multiple around wrappers can safely be cached'
	60	);
59	61
60		is_deeply( [ $foo->foo( foo => 1, bar => 2, quux => 3 ) ],
61		[ 3, 2, 1 ],
62		'multiple around wrappers can safely be cached (2nd time)' );
	62	is_deeply(
	63	[ $foo->foo( foo => 1, bar => 2, quux => 3 ) ],
	64	[ 3, 2, 1 ],
	65	'multiple around wrappers can safely be cached (2nd time)'
	66	);
63	67	}
64	68
	69	done_testing();

+0

-51

~~t/010.overloaded.t~~ less more

0		use Test::More tests => 4;
1		use strict;
2		use warnings;
3
4		{
5		package Foo;
6
7		use Moose;
8		use MooseX::Params::Validate;
9		use overload (
10		qw{""} => 'to_string',
11		);
12
13		has 'id' => (
14		is => 'ro',
15		isa => 'Str',
16		default => '1.10.100',
17		);
18
19		sub to_string {
20		my ( $self, %args ) = validated_hash(
21		\@_,
22		padded => {
23		isa => 'Bool',
24		optional => 1,
25		default => 0,
26		},
27		);
28
29		# 1.10.100 => 0001.0010.0100
30		my $id
31		= $args{padded}
32		? join( '.',
33		map { sprintf( "%04d", $_ ) } split( /\./, $self->id ) )
34		: $self->id;
35
36		return $id;
37		}
38		}
39
40		isa_ok( my $foo = Foo->new(), 'Foo', 'new' );
41
42		is( $foo->id, '1.10.100', 'id' );
43
44		is( $foo->to_string, '1.10.100', 'to_string' );
45
46		is(
47		$foo->to_string( padded => 1 ), '0001.0010.0100',
48		'to_string( padded => 1 )'
49		);
50

+54

-0

t/010_overloaded.t less more

	0	use Test::More;
	1	use strict;
	2	use warnings;
	3
	4	{
	5	package Foo;
	6
	7	use Moose;
	8	use MooseX::Params::Validate;
	9	use overload (
	10	qw{""} => 'to_string',
	11	);
	12
	13	has 'id' => (
	14	is => 'ro',
	15	isa => 'Str',
	16	default => '1.10.100',
	17	);
	18
	19	sub to_string {
	20	my ( $self, %args ) = validated_hash(
	21	\@_,
	22	padded => {
	23	isa => 'Bool',
	24	optional => 1,
	25	default => 0,
	26	},
	27	);
	28
	29	# 1.10.100 => 0001.0010.0100
	30	my $id
	31	= $args{padded}
	32	? join(
	33	'.',
	34	map { sprintf( "%04d", $_ ) } split( /\./, $self->id )
	35	)
	36	: $self->id;
	37
	38	return $id;
	39	}
	40	}
	41
	42	isa_ok( my $foo = Foo->new(), 'Foo', 'new' );
	43
	44	is( $foo->id, '1.10.100', 'id' );
	45
	46	is( $foo->to_string, '1.10.100', 'to_string' );
	47
	48	is(
	49	$foo->to_string( padded => 1 ), '0001.0010.0100',
	50	'to_string( padded => 1 )'
	51	);
	52
	53	done_testing();

+50

-0

t/011_allow_extra.t less more

	0	#!/usr/bin/perl
	1
	2	use strict;
	3	use warnings;
	4
	5	use Test::More;
	6	use Test::Fatal;
	7
	8	use MooseX::Params::Validate qw( validated_hash );
	9
	10	{
	11	sub foo {
	12	my %params = validated_hash(
	13	\@_,
	14	x => { isa => 'Int' },
	15	y => { isa => 'Int' },
	16	);
	17	\%params;
	18	}
	19
	20	sub bar {
	21	my %params = validated_hash(
	22	\@_,
	23	x => { isa => 'Int' },
	24	y => { isa => 'Int' },
	25	MX_PARAMS_VALIDATE_ALLOW_EXTRA => 1,
	26	);
	27	\%params;
	28	}
	29	}
	30
	31	is_deeply(
	32	bar( x => 42, y => 1 ),
	33	{ x => 42, y => 1 },
	34	'bar returns expected values with no extra params'
	35	);
	36
	37	is_deeply(
	38	bar( x => 42, y => 1, z => 'whatever' ),
	39	{ x => 42, y => 1, z => 'whatever' },
	40	'bar returns expected values with extra params'
	41	);
	42
	43	like(
	44	exception { foo( x => 42, y => 1, z => 'whatever' ) },
	45	qr/The following parameter .+ listed in the validation options: z/,
	46	'foo rejects extra params'
	47	);
	48
	49	done_testing();

+16

-0

t/release-eol.t less more

	0
	1	BEGIN {
	2	unless ($ENV{RELEASE_TESTING}) {
	3	require Test::More;
	4	Test::More::plan(skip_all => 'these tests are for release candidate testing');
	5	}
	6	}
	7
	8	use strict;
	9	use warnings;
	10	use Test::More;
	11
	12	eval 'use Test::EOL';
	13	plan skip_all => 'Test::EOL required' if $@;
	14
	15	all_perl_files_ok({ trailing_whitespace => 1 });

+16

-0

t/release-no-tabs.t less more

	0
	1	BEGIN {
	2	unless ($ENV{RELEASE_TESTING}) {
	3	require Test::More;
	4	Test::More::plan(skip_all => 'these tests are for release candidate testing');
	5	}
	6	}
	7
	8	use strict;
	9	use warnings;
	10	use Test::More;
	11
	12	eval 'use Test::NoTabs';
	13	plan skip_all => 'Test::NoTabs required' if $@;
	14
	15	all_perl_files_ok();

+19

-0

t/release-pod-coverage.t less more

	0	#!/usr/bin/perl
	1
	2	BEGIN {
	3	unless ($ENV{RELEASE_TESTING}) {
	4	require Test::More;
	5	Test::More::plan(skip_all => 'these tests are for release candidate testing');
	6	}
	7	}
	8
	9
	10	use strict;
	11	use warnings;
	12
	13	use Test::More;
	14
	15	eval "use Test::Pod::Coverage 1.04";
	16	plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
	17
	18	all_pod_coverage_ok( { trustme => [ qr/^(?:validatep?\|import)$/ ] } );

+38

-0

t/release-pod-spell.t less more

	0
	1	BEGIN {
	2	unless ($ENV{RELEASE_TESTING}) {
	3	require Test::More;
	4	Test::More::plan(skip_all => 'these tests are for release candidate testing');
	5	}
	6	}
	7
	8	use strict;
	9	use warnings;
	10
	11	use Test::More;
	12
	13	eval "use Test::Spelling";
	14	plan skip_all => "Test::Spelling required for testing POD coverage"
	15	if $@;
	16
	17	my @stopwords;
	18	for (<DATA>) {
	19	chomp;
	20	push @stopwords, $_
	21	unless /\A (?: \# \| \s* \z)/msx; # skip comments, whitespace
	22	}
	23
	24	add_stopwords(@stopwords);
	25	set_spell_cmd('aspell list -l en');
	26
	27	# This prevents a weird segfault from the aspell command - see
	28	# https://bugs.launchpad.net/ubuntu/+source/aspell/+bug/71322
	29	local $ENV{LC_ALL} = 'C';
	30	all_pod_files_spelling_ok();
	31
	32	__DATA__
	33	Stevan
	34	cpan
	35	isa
	36	param
	37	subname

+15

-0

t/release-pod-syntax.t less more

	0	#!perl
	1
	2	BEGIN {
	3	unless ($ENV{RELEASE_TESTING}) {
	4	require Test::More;
	5	Test::More::plan(skip_all => 'these tests are for release candidate testing');
	6	}
	7	}
	8
	9	use Test::More;
	10
	11	eval "use Test::Pod 1.41";
	12	plan skip_all => "Test::Pod 1.41 required for testing POD" if $@;
	13
	14	all_pod_files_ok();

+0

-8

~~xt/kwalitee.t~~ less more

0		use strict;
1		use warnings;
2
3		use Test::More;
4
5		eval { require Test::Kwalitee; Test::Kwalitee->import() };
6		plan skip_all => "Test::Kwalitee needed for testing kwalitee"
7		if $@;

+0

-11

~~xt/pod-coverage.t~~ less more

0		#!/usr/bin/perl
1
2		use strict;
3		use warnings;
4
5		use Test::More;
6
7		eval "use Test::Pod::Coverage 1.04";
8		plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
9
10		all_pod_coverage_ok( { trustme => [ qr/^(?:validatep?\|import)$/ ] } );

+0

-30

~~xt/pod-spell.t~~ less more

0		use strict;
1		use warnings;
2
3		use Test::More;
4
5		eval "use Test::Spelling";
6		plan skip_all => "Test::Spelling required for testing POD coverage"
7		if $@;
8
9		my @stopwords;
10		for (<DATA>) {
11		chomp;
12		push @stopwords, $_
13		unless /\A (?: \# \| \s* \z)/msx; # skip comments, whitespace
14		}
15
16		add_stopwords(@stopwords);
17		set_spell_cmd('aspell list -l en');
18
19		# This prevents a weird segfault from the aspell command - see
20		# https://bugs.launchpad.net/ubuntu/+source/aspell/+bug/71322
21		local $ENV{LC_ALL} = 'C';
22		all_pod_files_spelling_ok();
23
24		__DATA__
25		Stevan
26		cpan
27		isa
28		param
29		subname

+0

-9

~~xt/pod.t~~ less more

0		use strict;
1		use warnings;
2
3		use Test::More;
4
5		eval "use Test::Pod 1.14";
6		plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
7
8		all_pod_files_ok();