CPAN::FindDependencies - find dependencies for modules on the CPAN

    use CPAN::FindDependencies;
    my @dependencies = CPAN::FindDependencies::finddeps("CPAN");
    foreach my $dep (@dependencies) {
        print ' ' x $dep->depth();
        print $dep->name().' ('.$dep->distribution().")\n";
    }

#!perl -w

package CPAN::FindDependencies;

use strict;
use vars qw($p $VERSION @ISA @EXPORT_OK);

use YAML::Tiny ();
use LWP::Simple;
use Module::CoreList;
use Scalar::Util qw(blessed);
use CPAN::FindDependencies::Dependency;
use CPAN::FindDependencies::MakeMaker qw(getreqs_from_mm);
use Parse::CPAN::Packages;

require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(finddeps);

$VERSION = '2.34';

use constant DEFAULT02PACKAGES => 'http://www.cpan.org/modules/02packages.details.txt.gz';
use constant MAXINT => ~0;

sub finddeps {
    my($module, %opts) = @_;

    $opts{perl} ||= 5.005;
    $opts{maxdepth} ||= MAXINT;

    die(__PACKAGE__.": $opts{perl} is a broken version number\n")
        if($opts{perl} =~ /[^0-9.]/);

    if($opts{perl} =~ /\..*\./) {
        _emitwarning(
            "Three-part version numbers are a bad idea",
            %opts
        );
        my @parts = split(/\./, $opts{perl});
        $opts{perl} = $parts[0] + $parts[1] / 1000 + $parts[2] / 1000000;
    }

    if(!$p) {
        local $SIG{__WARN__} = sub {};
        $p = Parse::CPAN::Packages->new(_get02packages($opts{'02packages'}));
    }

    return _finddeps(
        opts    => \%opts,
        target  => $module,
        seen    => {},
        version => ($p->package($module) ? $p->package($module)->version() : 0)
    );
}

sub _emitwarning {
    my($msg, %opts) = @_;
    $msg = __PACKAGE__.": $msg\n";
    if(!$opts{nowarnings}) {
        if($opts{fatalerrors} ) {
            die('FATAL: '.$msg);
        } else {
            warn('WARNING: '.$msg);
        }
    }
}

sub _module2obj {
    my $module = shift;
    $module = $p->package($module);
    return undef if(!$module);
    return $module->distribution();
}

# FIXME make these memoise, maybe to disk
sub _finddeps { return @{_finddeps_uncached(@_)}; }

sub _get02packages {
    my $file = shift;
    if($file) {
        eval 'use URI::file';
        die($@) if($@);
        $file = URI::file->new_abs($file);
    }
    get($file || DEFAULT02PACKAGES) ||
        die(__PACKAGE__.": Couldn't fetch 02packages index file\n");
}

sub _incore {
    my %args = @_;
    my $core = $Module::CoreList::version{$args{perl}}{$args{module}};
    $core =~ s/_/00/g if($core);
    $args{version} =~ s/_/00/g;
    return ($core && $core >= $args{version}) ? $core : undef;
}

sub _finddeps_uncached {
    my %args = @_;
    my( $target, $opts, $depth, $version, $seen) = @args{qw(
        target opts depth version seen
    )};
    $depth ||= 0;

    return [] if(
        $target eq 'perl' ||
        _incore(
            module => $target,
            perl => $opts->{perl},
            version => $version)
    );

    my $dist = _module2obj($target);

    return [] unless(blessed($dist));

    my $author   = $dist->cpanid();
    my $distname = $dist->distvname();

    return [] if($seen->{$distname});
    $seen->{$distname} = 1;

    my %reqs = @{_getreqs(
        author   => $author,
        distname => $distname,
        opts     => $opts,
    )};
    my $warning = '';
    if($reqs{'-warning'}) {
        $warning = $reqs{'-warning'};
        %reqs = ();
    }

    return [
        CPAN::FindDependencies::Dependency->_new(
            depth      => $depth,
            cpanmodule => $target,
            p          => $p,
            version    => $version || 0,
            ($warning ? (warning => $warning) : ())
        ),
        ($depth != $opts->{maxdepth}) ? (map {
            # print "Looking at $_\n";
            _finddeps(
                target  => $_,
                opts    => $opts,
                depth   => $depth + 1,
                seen    => $seen,
                version => $reqs{$_}
            );
        } keys %reqs) : ()
    ];
}

sub _get_file_cached {
    my %args = @_;
    my($src, $destfile, $opts) = @args{qw(src destfile opts)};
    my $contents;
    if($opts->{cachedir} && -d $opts->{cachedir} && -r $opts->{cachedir}."/$destfile") {
        open(my $cachefh, $opts->{cachedir}."/$destfile") ||
            _emitwarning('Error reading '.$opts->{cachedir}."/$destfile: $!");
        local $/ = undef;
        $contents = <$cachefh>;
        close($cachefh);
    } else {
        $contents = get($src);
        if($contents && $opts->{cachedir} && -d $opts->{cachedir}) {
            open(my $cachefh, '>', $opts->{cachedir}."/$destfile") ||
                _emitwarning('Error writing '.$opts->{cachedir}."/$destfile: $!");
            print $cachefh $contents;
            close($cachefh);
        }
    }
    return $contents;
}

sub _getreqs {
    my %args = @_;
    my($author, $distname, $opts) = @args{qw(author distname opts)};

    # Prefer a META.yml, but if that's not found
    #     add the warning to the 'warning stack', if there is one
    # Try scanning the Makefile.PL if this is enabled
    #     if found, remove the META.yml warning and return deps
    # If neither is found, add warning to stack and return

    my $yaml = _get_file_cached(
        src => "http://search.cpan.org/src/$author/$distname/META.yml",
        destfile => "$distname.yml",
        opts => $opts
    );
    if ($yaml) {
        my $yaml = eval { YAML::Tiny::Load($yaml); };
        if ($@ || !defined($yaml)) {
            _emitwarning("$author/$distname: failed to parse META.yml", %{$opts})
        } else {
            $yaml->{requires} ||= {};
            $yaml->{build_requires} ||= {};
            $yaml->{recommends} ||= {};
            return [
	        %{$yaml->{requires}}, %{$yaml->{build_requires}},
		($opts->{recommended} ? %{$yaml->{recommends}} : ()),
	    ];
        }
    } else {
        _emitwarning("$author/$distname: no META.yml", %{$opts});
    }
        
    # We could have failed to parse the META.yml, but we still want to try the Makefile.PL
    if(!$opts->{usemakefilepl}) {
        return ['-warning', 'no META.yml'];
    } else {
        my $makefilepl = _get_file_cached(
            src => "http://search.cpan.org/src/$author/$distname/Makefile.PL",
            destfile => "$distname.MakefilePL",
            opts => $opts
        );
        if($makefilepl) {
            my $result = getreqs_from_mm($makefilepl);
            if ('HASH' eq ref $result) {
                return [ %{ $result } ];
            } else {
                _emitwarning("$author/$distname: $result", %{$opts});
                return ['-warning', $result];
            }
        } else {
            _emitwarning("$author/$distname: no META.yml nor Makefile.PL", %{$opts});
            return ['-warning', 'no META.yml nor Makefile.PL'];
        }
    }
}

1;