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";
	}
}

#Stolen from M::B
my %license_urls = (
    perl         => 'http://dev.perl.org/licenses/',
    apache       => 'http://apache.org/licenses/LICENSE-2.0',
    apache_1_1   => 'http://apache.org/licenses/LICENSE-1.1',
    artistic     => 'http://opensource.org/licenses/artistic-license.php',
    artistic_2   => 'http://opensource.org/licenses/artistic-license-2.0.php',
    lgpl         => 'http://opensource.org/licenses/lgpl-license.php',
    lgpl2        => 'http://opensource.org/licenses/lgpl-2.1.php',
    lgpl3        => 'http://opensource.org/licenses/lgpl-3.0.html',
    bsd          => 'http://opensource.org/licenses/bsd-license.php',
    gpl          => 'http://opensource.org/licenses/gpl-license.php',
    gpl2         => 'http://opensource.org/licenses/gpl-2.0.php',
    gpl3         => 'http://opensource.org/licenses/gpl-3.0.html',
    mit          => 'http://opensource.org/licenses/mit-license.php',
    mozilla      => 'http://opensource.org/licenses/mozilla1.1.php',
    open_source  => undef,
    unrestricted => undef,
    restrictive  => undef,
    unknown      => undef,
);

sub license {
	my $self = shift;
	return $self->{values}->{license} unless @_;
	my $license = shift or die(
		'Did not provide a value to license()'
	);
	$license = __extract_license($license) || lc $license;
	$self->{values}->{license} = $license;

	# Automatically fill in license URLs
	if ( $license_urls{$license} ) {
		$self->resources( license => $license_urls{$license} );
	}

	return 1;
}

sub _extract_license {
	my $pod = shift;
	my $matched;
	return __extract_license(
		($matched) = $pod =~ m/
			(=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
			(=head \d.*|=cut.*|)\z