view release on metacpan or  search on metacpan

bin/__perlbrewutils-probe  view on Meta::CPAN

		my $prefix = pop(@prefixes);
		my @dir_suffix = split(/::/, $prefix);
		my $module_rx =
			$prefix eq "" ? $root_leaf_rx : $notroot_leaf_rx;
		my $pm_rx = qr/\A($module_rx)\.pmc?\z/;
		my $pod_rx = qr/\A($module_rx)\.pod\z/;
		my $dir_rx =
			$prefix eq "" ? $root_notleaf_rx : $notroot_notleaf_rx;
		$dir_rx = qr/\A$dir_rx\z/;
		foreach my $incdir (@INC) {
			my $dir = join("/", $incdir, @dir_suffix);
			opendir(my $dh, $dir) or next;
			while(defined(my $entry = readdir($dh))) {
				if(($list_modules && $entry =~ $pm_rx) ||
						($list_pod &&
							$entry =~ $pod_rx)) {
                                            next if $find_pm && "$prefix$1" ne $find_pm;
                                            $results{$prefix.$1} = $return_path ? ($all ? [@{ $results{$prefix.$1} || [] }, "$dir/$entry"] : "$dir/$entry") : undef
						if $all && $return_path || !exists($results{$prefix.$1});
                                            last LIST if $find_pm;
				} elsif(($list_prefixes || $recurse) &&
						($entry ne '.' && $entry ne '..') &&
						$entry =~ $dir_rx &&
						-d join("/", $dir,
							$entry)) {
					my $newpfx = $prefix.$entry."::";
					next if exists $seen_prefixes{$newpfx};
					$results{$newpfx} ||= $return_path ? ($all ? [@{ $results{$newpfx} || [] }, "$dir/$entry/"] : "$dir/$entry/") : undef
						if ($all && $return_path || !exists($results{$newpfx})) && $list_prefixes;
					push @prefixes, $newpfx if $recurse;
				}
			}
			next unless $list_pod && $use_pod_dir;
			$dir = join("/", $dir, "pod");
			opendir($dh, $dir) or next;
			while(defined(my $entry = readdir($dh))) {
				if($entry =~ $pod_rx) {
					$results{$prefix.$1} = $return_path ? ($all ? [@{ $results{$prefix.$1} || [] }, "$dir/$entry"] : "$dir/$entry") : undef;
				}
			}
		}
	}
	return \%results;
}

{
    local $Data::Dumper::Terse = 1;
    local $Data::Dumper::Indent = 1;
    local @INC = grep {$_ ne '.'} @INC;
    my $lmres;

    if (@ARGV) {
        $lmres = list_modules(
            '', {list_modules=>1, recurse=>1, return_path=>1, find_pm=>$ARGV[0]});
    } else {
        $lmres = list_modules(
            '', {list_modules=>1, recurse=>1});
    }
    my $res = {
        modules => $lmres,
        usethreads => $Config{usethreads},
        uselongdouble => $Config{uselongdouble},
        usemultiplicity => $Config{usemultiplicity}
    };
    print Dumper($res);
}

1;
# ABSTRACT: Prober script
# PODNAME: __perlbrewutils-probe

__END__

=pod

=encoding UTF-8

=head1 NAME

__perlbrewutils-probe - Prober script

=head1 VERSION

This document describes version 0.04 of __perlbrewutils-probe (from Perl distribution App-PerlbrewUtils), released on 2016-06-02.

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/App-PerlbrewUtils>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-App-PerlbrewUtils>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-PerlbrewUtils>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2016 by perlancar@cpan.org.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut