view release on metacpan or  search on metacpan

lib/App/prepare4release/Deps.pm  view on Meta::CPAN

use utf8;

use Carp qw(croak);
use File::Find ();
use File::Spec ();

# Optional: used to skip core modules without an explicit minimum version.
sub _have_corelist {
	state $ok = eval { require Module::CoreList; 1 };
	return $ok;
}

sub _perl_numeric_for_corelist {
	my ( $class, $mf_content, $config, $version_from_path ) = @_;
	$config = {} unless ref $config eq 'HASH';

	my $raw = $config->{min_perl_version} // $config->{perl_min};
	if ( defined $raw && length $raw ) {
		return $class->_perl_num_from_any($raw);
	}
	if ( ref $mf_content eq 'SCALAR' || defined $mf_content ) {
		my $s = ref $mf_content eq 'SCALAR' ? $$mf_content : $mf_content;
		if ( $s =~ /MIN_PERL_VERSION\s*=>\s*['"]([^'"]+)['"]/ ) {
			return $class->_perl_num_from_any($1);
		}
	}
	if ( defined $version_from_path && -e $version_from_path ) {
		open my $fh, '<:encoding(UTF-8)', $version_from_path or return '5.010000';
		while ( my $line = <$fh> ) {
			if ( $line =~ /^\s*use\s+v([0-9.]+)\s*;/ ) {
				close $fh;
				return $class->_perl_num_from_any( 'v' . $1 );
			}
			if ( $line =~ /^\s*use\s+([0-9][0-9_\.]+)\s*;/ ) {
				close $fh;
				return $class->_perl_num_from_any($1);
			}
		}
		close $fh;
	}
	return '5.010000';
}

sub _perl_num_from_any {
	my ( $class, $v ) = @_;
	return '5.010000' unless defined $v && length $v;
	require version;
	my $ver = eval { version->parse($v) };
	return '5.010000' unless $ver;
	return $ver->numify;
}

sub _skip_use_module {
	my ( $class, $m ) = @_;
	return 1 unless defined $m && length $m;
	return 1 if $m =~ /^v?5\.\d+/;
	return 1 if $m eq 'perl';
	my %pragma = map { $_ => 1 } qw(
		strict warnings utf8 feature experimental subs mro overload
		vars integer English autodie lib constant deprecate
		open sigtrap sort attrs bytes charnames locale
		namespaces tie filetest indirect
	);
	return 1 if $pragma{$m};
	return 0;
}

sub _strip_pod {
	my ( $class, $text ) = @_;
	$text =~ s{^=[a-z][a-z]*\b.*?^=cut\b}{}gms;
	return $text;
}

sub _scan_line_for_modules {
	my ( $class, $line, $out ) = @_;
	$out = [] unless ref $out eq 'ARRAY';

	# use v5.xx / use 5.xx
	return if $line =~ /^\s*use\s+v?[0-9]/;

	if ( $line =~ /^\s*use\s+parent\s+(.+)/ ) {
		my $rest = $1;
		if ( $rest =~ /qw\s*\(\s*([^)]*)\s*\)/ ) {
			my $inner = $1;
			for my $w ( split /\s+/, $inner ) {
				next unless $w =~ /^[\w:]+$/;
				push @{$out}, [ $w, undef ];
			}
		}
		elsif ( $rest =~ /['"]([\w:]+)['"]/ ) {
			push @{$out}, [ $1, undef ];
		}
		return;
	}

	if ( $line =~ /^\s*use\s+base\s+(.+)/ ) {
		my $rest = $1;
		if ( $rest =~ /qw\s*\(\s*([^)]*)\s*\)/ ) {
			for my $w ( split /\s+/, $1 ) {
				next unless $w =~ /^[\w:]+$/;
				push @{$out}, [ $w, undef ];
			}
		}
		elsif ( $rest =~ /['"]([\w:]+)['"]/ ) {
			push @{$out}, [ $1, undef ];
		}
		return;
	}

	if ( $line =~ /^\s*use\s+([\w:]+)\s+([\d._v]+)\s*;/ ) {
		my ( $m, $v ) = ( $1, $2 );
		return if $class->_skip_use_module($m);
		push @{$out}, [ $m, $v ];
		return;
	}

	if ( $line =~ /^\s*use\s+([\w:]+)\s+qw\s*\(/ ) {
		my $m = $1;
		return if $class->_skip_use_module($m);
		push @{$out}, [ $m, undef ];
		return;