Commit 5d4857e48000f747b564b7f6abba84bf4a86b56b - libvitacilina-perl

[svn-upgrade] Integrating new upstream version, libvitacilina-perl (0.2) Angel Abad Contreras 14 years ago

16 changed file(s) with 502 addition(s) and 219 deletion(s). Raw diff Collapse all Expand all

-0

.gitignore less more

	0	Makefile
	1	blib
	2	pm_to_blib

-0

Changes less more

	0	- require perl 5.006 (Alexandr Ciornii)
	1	- correct list of prereqs (Alexandr Ciornii)
	2	- repository in META.yml (Alexandr Ciornii)
	3	- simple test added (Alexandr Ciornii)

-0

MANIFEST less more

5	5	lib/Vitacilina.pm
6	6	Makefile.PL
7	7	MANIFEST
	8	Changes
	9	t/00_compile.t

+17

-4

META.yml less more

0	0	---
1	1	abstract: '¡Ah, qué buena medicina!'
2	2	author:
3		- 'David Moreno <david@axiombox.com>.'
	3	- 'David Moreno, david@axiombox.com. Alexandr Ciornii contributed with'
	4	build_requires:
	5	ExtUtils::MakeMaker: 6.42
	6	Test::More: 0
	7	configure_requires:
	8	ExtUtils::MakeMaker: 6.42
4	9	distribution_type: module
5		generated_by: 'Module::Install version 0.78'
	10	generated_by: 'Module::Install version 0.91'
6	11	license: perl
7	12	meta-spec:
8	13	url: http://module-build.sourceforge.net/META-spec-v1.4.html

12	17	directory:
13	18	- examples
14	19	- inc
	20	- t
15	21	requires:
	22	Data::Dumper: 0
	23	DateTime: 0
	24	LWP::UserAgent: 0
	25	Template: 0
	26	URI: 0
16	27	XML::Feed: 0.41
17		perl: 5.005
	28	YAML::Syck: 0
	29	perl: 5.6.0
18	30	resources:
19	31	license: http://dev.perl.org/licenses/
20		version: 0.1
	32	repository: http://github.com/damog/vitacilina/tree
	33	version: 0.2

+11

-1

Makefile.PL less more

0	0	#!/usr/bin/env perl
1	1
2		use inc::Module::Install;
	2	use inc::Module::Install 0.75;
3	3
4	4	name 'Vitacilina';
5	5	all_from 'lib/Vitacilina.pm';
6	6
7	7	requires 'XML::Feed' => '0.41';
	8	requires 'URI' => '0';
	9	requires 'Template' => '0';
	10	requires 'YAML::Syck' => '0';
	11	requires 'Data::Dumper' => '0';
	12	requires 'LWP::UserAgent' => '0';
	13	requires 'DateTime' => '0';
	14	build_requires 'Test::More' => '0';
	15
8	16	no_index directory => 'examples';
9	17	# license_from 'LICENSE';
10	18
	19	repository 'http://github.com/damog/vitacilina/tree';
	20
11	21	WriteAll;

-3

README less more

52	52
53	53	SEE ALSO
54	54	Git repository is located at <http://github.com/damog/vitacilina>. Also
55		take a look at the Infinite Pig Theorem blog where similar developments
56		from the author are announced and sampled, <http://log.damog.net/>.
	55	take a look at the Stereonaut! blog where similar developments from the
	56	author are announced and sampled, <http://log.damog.net/>.
57	57
58	58	AUTHOR
59		David Moreno, david@axiombox.com.
	59	David Moreno, david@axiombox.com. Alexandr Ciornii contributed with
	60	patches.
60	61
61	62	COPYRIGHT
62	63	Copyright (C) 2009 by David Moreno.

+33

-27

inc/Module/Install/Base.pm less more

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

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

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

-10

inc/Module/Install/Can.pm less more

1	1	package Module::Install::Can;
2	2
3	3	use strict;
4		use Module::Install::Base;
5		use Config ();
6		### This adds a 5.005 Perl version dependency.
7		### This is a bug and will be fixed.
8		use File::Spec ();
9		use ExtUtils::MakeMaker ();
	4	use Config ();
	5	use File::Spec ();
	6	use ExtUtils::MakeMaker ();
	7	use Module::Install::Base ();
10	8
11		use vars qw{$VERSION $ISCORE @ISA};
	9	use vars qw{$VERSION @ISA $ISCORE};
12	10	BEGIN {
13		$VERSION = '0.78';
	11	$VERSION = '0.91';
	12	@ISA = 'Module::Install::Base';
14	13	$ISCORE = 1;
15		@ISA = qw{Module::Install::Base};
16	14	}
17	15
18	16	# check if we can load some module

79	77
80	78	__END__
81	79
82		#line 158
	80	#line 156

-4

inc/Module/Install/Fetch.pm less more

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

+33

-18

inc/Module/Install/Makefile.pm less more

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

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

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

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

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

+257

-116

inc/Module/Install/Metadata.pm less more

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

36	40	repository
37	41	};
38	42
	43	my @array_keys = qw{
	44	keywords
	45	};
	46
39	47	sub Meta { shift }
	48	sub Meta_BooleanKeys { @boolean_keys }
40	49	sub Meta_ScalarKeys { @scalar_keys }
41	50	sub Meta_TupleKeys { @tuple_keys }
42	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	}
43	64
44	65	foreach my $key ( @scalar_keys ) {
45	66	*$key = sub {
46	67	my $self = shift;
47		return $self->{values}{$key} if defined wantarray and !@_;
48		$self->{values}{$key} = 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}}, @_;
49	80	return $self;
50	81	};
51	82	}

54	85	*$key = sub {
55	86	my $self = shift;
56	87	unless ( @_ ) {
57		return () unless $self->{values}{resources};
	88	return () unless $self->{values}->{resources};
58	89	return map { $_->[1] }
59	90	grep { $_->[0] eq $key }
60		@{ $self->{values}{resources} };
61		}
62		return $self->{values}{resources}{$key} unless @_;
	91	@{ $self->{values}->{resources} };
	92	}
	93	return $self->{values}->{resources}->{$key} unless @_;
63	94	my $uri = shift or die(
64	95	"Did not provide a value to $key()"
65	96	);

68	99	};
69	100	}
70	101
71		sub requires {
72		my $self = shift;
73		while ( @_ ) {
74		my $module = shift or last;
75		my $version = shift \|\| 0;
76		push @{ $self->{values}{requires} }, [ $module, $version ];
77		}
78		$self->{values}{requires};
79		}
80
81		sub build_requires {
82		my $self = shift;
83		while ( @_ ) {
84		my $module = shift or last;
85		my $version = shift \|\| 0;
86		push @{ $self->{values}{build_requires} }, [ $module, $version ];
87		}
88		$self->{values}{build_requires};
89		}
90
91		sub configure_requires {
92		my $self = shift;
93		while ( @_ ) {
94		my $module = shift or last;
95		my $version = shift \|\| 0;
96		push @{ $self->{values}{configure_requires} }, [ $module, $version ];
97		}
98		$self->{values}{configure_requires};
99		}
100
101		sub recommends {
102		my $self = shift;
103		while ( @_ ) {
104		my $module = shift or last;
105		my $version = shift \|\| 0;
106		push @{ $self->{values}{recommends} }, [ $module, $version ];
107		}
108		$self->{values}{recommends};
109		}
110
111		sub bundles {
112		my $self = shift;
113		while ( @_ ) {
114		my $module = shift or last;
115		my $version = shift \|\| 0;
116		push @{ $self->{values}{bundles} }, [ $module, $version ];
117		}
118		$self->{values}{bundles};
	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	};
119	115	}
120	116
121	117	# Resource handling

134	130	if ( $name eq lc $name and ! $lc_resource{$name} ) {
135	131	die("Unsupported reserved lowercase resource '$name'");
136	132	}
137		$self->{values}{resources} \|\|= [];
138		push @{ $self->{values}{resources} }, [ $name, $value ];
139		}
140		$self->{values}{resources};
	133	$self->{values}->{resources} \|\|= [];
	134	push @{ $self->{values}->{resources} }, [ $name, $value ];
	135	}
	136	$self->{values}->{resources};
141	137	}
142	138
143	139	# Aliases for build_requires that will have alternative
144	140	# meanings in some future version of META.yml.
145		sub test_requires { shift->build_requires(@_) }
146		sub install_requires { shift->build_requires(@_) }
	141	sub test_requires { shift->build_requires(@_) }
	142	sub install_requires { shift->build_requires(@_) }
147	143
148	144	# Aliases for installdirs options
149		sub install_as_core { $_[0]->installdirs('perl') }
150		sub install_as_cpan { $_[0]->installdirs('site') }
151		sub install_as_site { $_[0]->installdirs('site') }
152		sub install_as_vendor { $_[0]->installdirs('vendor') }
153
154		sub sign {
155		my $self = shift;
156		return $self->{values}{sign} if defined wantarray and ! @_;
157		$self->{values}{sign} = ( @_ ? $_[0] : 1 );
158		return $self;
159		}
	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') }
160	149
161	150	sub dynamic_config {
162	151	my $self = shift;

164	153	warn "You MUST provide an explicit true/false value to dynamic_config\n";
165	154	return $self;
166	155	}
167		$self->{values}{dynamic_config} = $_[0] ? 1 : 0;
	156	$self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
168	157	return 1;
169	158	}
170	159
171	160	sub perl_version {
172	161	my $self = shift;
173		return $self->{values}{perl_version} unless @_;
	162	return $self->{values}->{perl_version} unless @_;
174	163	my $version = shift or die(
175	164	"Did not provide a value to perl_version()"
176	165	);
177	166
178		# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
179		# numbers (eg, 5.006001 or 5.008009).
180		# Also, convert double-part versions (eg, 5.8)
181
182		$version =~ s/^(\d+)\.(\d+)(?:\.(\d+))?$/sprintf("%d.%03d%03d",$1,$2,$3 \|\| 0)/e;
183
184		$version =~ s/_.+$//;
185		$version = $version + 0; # Numify
	167	# Normalize the version
	168	$version = $self->_perl_version($version);
	169
	170	# We don't support the reall old versions
186	171	unless ( $version >= 5.005 ) {
187	172	die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
188	173	}
189		$self->{values}{perl_version} = $version;
190		return 1;
191		}
	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	);
192	198
193	199	sub license {
194	200	my $self = shift;
195		return $self->{values}{license} unless @_;
	201	return $self->{values}->{license} unless @_;
196	202	my $license = shift or die(
197	203	'Did not provide a value to license()'
198	204	);
199		$self->{values}{license} = $license;
	205	$self->{values}->{license} = $license;
200	206
201	207	# Automatically fill in license URLs
202		if ( $license eq 'perl' ) {
203		$self->resources( license => 'http://dev.perl.org/licenses/' );
	208	if ( $license_urls{$license} ) {
	209	$self->resources( license => $license_urls{$license} );
204	210	}
205	211
206	212	return 1;

242	248
243	249	sub provides {
244	250	my $self = shift;
245		my $provides = ( $self->{values}{provides} \|\|= {} );
	251	my $provides = ( $self->{values}->{provides} \|\|= {} );
246	252	%$provides = (%$provides, @_) if @_;
247	253	return $provides;
248	254	}

271	277	sub feature {
272	278	my $self = shift;
273	279	my $name = shift;
274		my $features = ( $self->{values}{features} \|\|= [] );
	280	my $features = ( $self->{values}->{features} \|\|= [] );
275	281	my $mods;
276	282
277	283	if ( @_ == 1 and ref( $_[0] ) ) {

299	305	while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
300	306	$self->feature( $name, @$mods );
301	307	}
302		return $self->{values}{features}
303		? @{ $self->{values}{features} }
	308	return $self->{values}->{features}
	309	? @{ $self->{values}->{features} }
304	310	: ();
305	311	}
306	312
307	313	sub no_index {
308	314	my $self = shift;
309	315	my $type = shift;
310		push @{ $self->{values}{no_index}{$type} }, @_ if $type;
311		return $self->{values}{no_index};
	316	push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
	317	return $self->{values}->{no_index};
312	318	}
313	319
314	320	sub read {

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

461	467	return 'unknown';
462	468	}
463	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
464	478	sub bugtracker_from {
465	479	my $self = shift;
466	480	my $content = Module::Install::_read($_[0]);
467		my @links = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g;
	481	my @links = _extract_bugtracker($content);
468	482	unless ( @links ) {
469	483	warn "Cannot determine bugtracker info from $_[0]\n";
470	484	return 0;

479	493	return 1;
480	494	}
481	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
482	623	1;

-3

inc/Module/Install/Win32.pm less more

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

+23

-3

inc/Module/Install/WriteAll.pm less more

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

21	21	);
22	22
23	23	$self->sign(1) if $args{sign};
24		$self->Meta->write if $args{meta};
25	24	$self->admin->WriteAll(%args) if $self->is_admin;
26	25
27	26	$self->check_nmake if $args{check_nmake};

29	28	$self->makemaker_args( PL_FILES => {} );
30	29	}
31	30
	31	# Until ExtUtils::MakeMaker support MYMETA.yml, make sure
	32	# we clean it up properly ourself.
	33	$self->realclean_files('MYMETA.yml');
	34
32	35	if ( $args{inline} ) {
33	36	$self->Inline->write;
34	37	} else {
35	38	$self->Makefile->write;
36	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;
37	57	}
38	58
39	59	1;

+87

-26

inc/Module/Install.pm less more

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

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

68	69	# again. This is bad. Rather than taking action to touch it (which
69	70	# is unreliable on some platforms and requires write permissions)
70	71	# for now we should catch this and refuse to run.
71		if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" }
72
73		Your installer $0 has a modification time in the future.
	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).
74	85
75	86	This is known to create infinite loops in make.
76	87
77	88	Please correct this, then run $0 again.
78	89
79	90	END_DIE
	91	}
80	92
81	93
82	94

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

152	172	delete $INC{"$self->{file}"};
153	173	delete $INC{"$self->{path}.pm"};
154	174
	175	# Save to the singleton
	176	$MAIN = $self;
	177
155	178	return 1;
156	179	}
157	180

165	188
166	189	my @exts = @{$self->{extensions}};
167	190	unless ( @exts ) {
168		my $admin = $self->{admin};
169		@exts = $admin->load_all_extensions;
	191	@exts = $self->{admin}->load_all_extensions;
170	192	}
171	193
172	194	my %seen;

249	271	sub load_extensions {
250	272	my ($self, $path, $top) = @_;
251	273
252		unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
	274	unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
253	275	unshift @INC, $self->{prefix};
254	276	}
255	277

313	335
314	336
315	337	#####################################################################
316		# Utility Functions
	338	# Common Utility Functions
317	339
318	340	sub _caller {
319	341	my $depth = 0;

327	349
328	350	sub _read {
329	351	local *FH;
330		open FH, "< $_[0]" or die "open($_[0]): $!";
331		my $str = do { 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> };
332	358	close FH or die "close($_[0]): $!";
333		return $str;
	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;
334	379	}
335	380
336	381	sub _write {
337	382	local *FH;
338		open FH, "> $_[0]" or die "open($_[0]): $!";
339		foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
	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	}
340	391	close FH or die "close($_[0]): $!";
341	392	}
342	393
343	394	# _version is for processing module versions (eg, 1.03_05) not
344	395	# Perl versions (eg, 5.8.1).
345
346	396	sub _version ($) {
347	397	my $s = shift \|\| 0;
348		$s =~ s/^(\d+)\.?//;
	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+)\.?//;
349	404	my $l = $1 \|\| 0;
350		my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
351		$l = $l . '.' . join '', @v if @v;
	405	my @v = map {
	406	$_ . '0' x (3 - length $_)
	407	} $s =~ /(\d{1,3})\D?/g;
	408	$l = $l . '.' . join '', @v if @v;
352	409	return $l + 0;
	410	}
	411
	412	sub _cmp ($$) {
	413	_version($_[0]) <=> _version($_[1]);
353	414	}
354	415
355	416	# Cloned from Params::Util::_CLASS

359	420	and
360	421	! ref $_[0]
361	422	and
362		$_[0] =~ m/^[^\W\d]\w(?:::\w+)$/s
	423	$_[0] =~ m/^[^\W\d]\w(?:::\w+)\z/s
363	424	) ? $_[0] : undef;
364	425	}
365	426

-4

lib/Vitacilina.pm less more

63	63	=head1 SEE ALSO
64	64
65	65	Git repository is located at L<http://github.com/damog/vitacilina>.
66		Also take a look at the Infinite Pig Theorem blog where similar
	66	Also take a look at the Stereonaut! blog where similar
67	67	developments from the author are announced and sampled,
68	68	L<http://log.damog.net/>.
69	69
70	70	=head1 AUTHOR
71	71
72		David Moreno, david@axiombox.com.
	72	David Moreno, david@axiombox.com. Alexandr Ciornii contributed with
	73	patches.
73	74
74	75	=head1 COPYRIGHT
75	76

82	83
83	84	package Vitacilina;
84	85
	86	use 5.006;
	87
85	88	use strict;
86	89	use warnings;
87	90
88		use 5.005;
89	91
90	92	use URI;
91	93	use Template;
92	94	use XML::Feed;
93	95	use YAML::Syck;
94	96	use Data::Dumper;
	97	use LWP::UserAgent;
	98	use DateTime;
	99
95	100	use Carp;
96	101
97	102	use Vitacilina::Config qw/$FORMAT $OUTPUT $TITLE $LIMIT/;

99	104	# Constant: VERSION
100	105	#
101	106	# Vitacilina version
102		our $VERSION = '0.1';
	107	our $VERSION = '0.2';
103	108
104	109	my $params = {
105	110	required => [qw{config template}],

-0

t/00_compile.t less more

	0	use strict;
	1	use Test::More tests => 1;
	2
	3	BEGIN { use_ok 'Vitacilina' }