show_deps.pl

#!/usr/bin/perl -w

use strict;
use Pod::Usage;
use Getopt::Long;

GetOptions( 'h|help' => sub { pod2usage(1); } );

pod2usage("no module name given") if !$ARGV[0];

my $dep = Dep->new();
my $all = $dep->for( $ARGV[0] );
print join(" => ", @$_), "\n" foreach @$all;




package Dep;

use JSON;
use LWP::Simple;
use Module::CoreList;

sub new {
    my ($class) = @_;
    my $self = {};
    foreach my $name ( keys %{ $Module::CoreList::version{'5.008'} } ) {
        $name =~ s{::}{-}g;
        $self->{core}->{$name} = 1;
    }
    bless $self, $class;
    return $self;
}

sub for {
    my ( $self, $module, $substract ) = @_;
    my $dep_list;
    my $itr =
        $substract
      ? $self->get_deps($module)
      : $self->get_deps( $module, $substract );
    while ( my $next = $itr->() ) {
        push @$dep_list, $next;
    }
    return $dep_list if $dep_list;
}

sub get_deps {
    my ( $self, $module, $substract ) = @_;
    $module =~ s{::}{-}g;
    $substract =~ s{::}{-}g if $substract;

    my $base = 'http://cpants.perl.org/json/dist/dependencies/';
    my $deps = {};    # to check for duplicates
    my @stack;        # to store the deps
    push @stack, $module;
    my $pointer = 1;    #to keep track which one to be returned

    return sub {
        return 0 if $pointer > scalar @stack;
      STACK:
        foreach my $i ( $pointer - 1 .. $#stack ) {
            if ($substract eq $stack[$i]) {
            	 $pointer++;
            	 next STACK;
						}

            my $url = $base . $stack[$i];

            #get the JSON from CPANTS
            my $content = get $url;
            next STACK if !$content;

            my $perl_scalar = from_json($content);

          PREREQS:
            foreach my $elem ( @{ $perl_scalar->{prereqs} } ) {
                ( my $depname = $elem->{requires} ) =~ s{::}{-}g;

                next PREREQS if defined $self->{core}->{$depname};
                next PREREQS if defined $deps->{$depname};
                next PREREQS if $depname eq 'perl';

                $deps->{$depname} = $elem->{version};
                push @stack, $depname;

            }
            return 0 if $pointer >= scalar @stack;
            my $val = $stack[$pointer];
            $pointer++;
            return [ $val, $deps->{$val} ];
        }

      }
}

1;