view release on metacpan or  search on metacpan

inc/Module/Install/Metadata.pm  view on Meta::CPAN

	} else {
		die("Cannot determine name from $file\n");
	}
}

sub _extract_perl_version {
	if (
		$_[0] =~ m/
		^\s*
		(?:use|require) \s*
		v?
		([\d_\.]+)
		\s* ;
		/ixms
	) {
		my $perl_version = $1;
		$perl_version =~ s{_}{}g;
		return $perl_version;
	} else {
		return;
	}
}

sub perl_version_from {
	my $self = shift;
	my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
	if ($perl_version) {
		$self->perl_version($perl_version);
	} else {
		warn "Cannot determine perl version info from $_[0]\n";
		return;
	}
}

sub author_from {
	my $self    = shift;
	my $content = Module::Install::_read($_[0]);
	if ($content =~ m/
		=head \d \s+ (?:authors?)\b \s*
		([^\n]*)
		|
		=head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
		.*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
		([^\n]*)
	/ixms) {
		my $author = $1 || $2;

		# XXX: ugly but should work anyway...
		if (eval "require Pod::Escapes; 1") {
			# Pod::Escapes has a mapping table.
			# It's in core of perl >= 5.9.3, and should be installed
			# as one of the Pod::Simple's prereqs, which is a prereq
			# of Pod::Text 3.x (see also below).
			$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
			{
				defined $2
				? chr($2)
				: defined $Pod::Escapes::Name2character_number{$1}
				? chr($Pod::Escapes::Name2character_number{$1})
				: do {
					warn "Unknown escape: E<$1>";
					"E<$1>";
				};
			}gex;
		}
		elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
			# Pod::Text < 3.0 has yet another mapping table,
			# though the table name of 2.x and 1.x are different.
			# (1.x is in core of Perl < 5.6, 2.x is in core of
			# Perl < 5.9.3)
			my $mapping = ($Pod::Text::VERSION < 2)
				? \%Pod::Text::HTML_Escapes
				: \%Pod::Text::ESCAPES;
			$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
			{
				defined $2
				? chr($2)
				: defined $mapping->{$1}
				? $mapping->{$1}
				: do {
					warn "Unknown escape: E<$1>";
					"E<$1>";
				};
			}gex;
		}
		else {
			$author =~ s{E<lt>}{<}g;
			$author =~ s{E<gt>}{>}g;
		}
		$self->author($author);
	} else {
		warn "Cannot determine author info from $_[0]\n";
	}
}

sub _extract_license {
	my $pod = shift;
	my $matched;
	return __extract_license(
		($matched) = $pod =~ m/
			(=head \d \s+ (?:licen[cs]e|licensing)\b.*?)
			(=head \d.*|=cut.*|)\z
		/ixms
	) || __extract_license(
		($matched) = $pod =~ m/
			(=head \d \s+ (?:copyrights?|legal)\b.*?)
			(=head \d.*|=cut.*|)\z
		/ixms
	);
}

sub __extract_license {
	my $license_text = shift or return;
	my @phrases      = (
		'under the same (?:terms|license) as (?:perl|the perl programming language)' => 'perl', 1,
		'under the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
		'Artistic and GPL'                   => 'perl',        1,
		'GNU general public license'         => 'gpl',         1,
		'GNU public license'                 => 'gpl',         1,
		'GNU lesser general public license'  => 'lgpl',        1,
		'GNU lesser public license'          => 'lgpl',        1,
		'GNU library general public license' => 'lgpl',        1,
		'GNU library public license'         => 'lgpl',        1,
		'BSD license'                        => 'bsd',         1,
		'Artistic license'                   => 'artistic',    1,
		'GPL'                                => 'gpl',         1,
		'LGPL'                               => 'lgpl',        1,
		'BSD'                                => 'bsd',         1,
		'Artistic'                           => 'artistic',    1,
		'MIT'                                => 'mit',         1,
		'proprietary'                        => 'proprietary', 0,
	);
	while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
		$pattern =~ s#\s+#\\s+#gs;
		if ( $license_text =~ /\b$pattern\b/i ) {
			return $license;
		}
	}
}

sub license_from {