#!/usr/bin/perl
use warnings;
use strict;
# $|=1;

$ENV{PERL_MM_USE_DEFAULT}++;
use ExtUtils::MakeMaker;
use GraphViz ();
use CPAN ();
use LWP::Simple qw(get);
# use DDS qw(Dump Dumper);
use Data::Dumper qw(Dumper);
use YAML ();

# Ugh.  Semi-global.
my %makemaker_info;
{
  no warnings 'redefine';
  sub ExtUtils::MakeMaker::WriteMakefile {
    %makemaker_info = @_;
  }
}

my @workqueue = @ARGV;
my %done;
my %blacklist = (# No metadata source
                 'ABERGMAN/ponie-2'=>'', 
                 # Requires it's Changes file
                 'GAAS/libwww-perl-5.79'=>'', 
                 # system('make'), which I can't figure out how to kee
+p from getting to STDOUT
                 'GBARR/Scalar-List-Utils-1.13'=>'' 
                );

sub print_sts {
  print STDERR @_;
}

my $graph = GraphViz->new;

# Force CPAN to load it's stuff now, so we don't have to worry
# about rejigging STDOUT every time.
{
  local *STDOUT;
  *STDOUT=*STDERR{IO};
  CPAN::expand('Module', 'this_does_not_exist');
}

while (@workqueue) {
  my $name = shift @workqueue;
  next if ($done{$name});
  
  print_sts "Working on $name\n";
  
  my $module = CPAN::expand("Module", $name);
  if (!$module) {
    warn "Couldn't find $name on CPAN!\n";
    next;
  }
  
  print_sts Dumper($module);
  
  
  my @depends = eval {get_dependlist($module)};
  

  if ($@) {
    $graph->add_node($name, cluster => distro_name($module), color => 
+'red');
  } else {
    $graph->add_node($name, cluster => distro_name($module));
    foreach my $submod (@depends) {
      print_sts "$name depends on $submod\n";
      push @workqueue, $submod;
      $graph->add_edge($name, $submod);
    }
  }
  
  
  $done{$name}++;
}

print_sts "Rendering\n";

print $graph->as_png;

sub get_dependlist {
  my $module=shift;
  
  my $sco_path = sco_path($module);
  
  if (!$sco_path) {
    print_sts "Skipping.\n";
    die "Blacklisted";
  }
  
  print_sts "... at sco path $sco_path\n";
  
  my $metayaml = get("$sco_path/META.yml");
  
  if ($metayaml) {
    my $meta = YAML::Load($metayaml);
    
    # Some META.ymls seem to give requires as empty-string.
    # for example, Class-Factory-Util.
    return unless ref($meta->{requires}) eq 'HASH';
    
    return (keys %{$meta->{requires}});
  }
  
  my $makefilepl = get("$sco_path/Makefile.PL");

  if ($makefilepl) {
    {
      # Keep the Makefile.PL from trashing our standard out (which sho
+uld be a png).
      local *STDOUT;
      *STDOUT=*STDERR{IO};
      local *STDIN;
      *STDIN=*STDERR{IO};
      no warnings; no strict;
      eval $makefilepl;
    }
    
    if ($@) {
      die "Couldn't eval Makefile.PL: $@";
    }
    
    return keys %{$makemaker_info{PREREQ_PM}};
  }

  
  die "Couldn't find any way to get metadata for $sco_path.\n";
}

# Given a CPAN::Module object, return the base URI to the extracted ve
+rsion
# on search.cpan.org
sub sco_path {
  my $mod = shift;
  
  # FIXME: Is there a better way to get this?
  # NOTE: Test with "perl"; it has userid P5P, but is in the directory
+ of the
  # current stable pumpking
  my $cpanf = $mod->cpan_file;
  unless ($cpanf =~ m|/.*/([^/]+/.*).tar.gz$|) {
    die "Can't find distro name from $cpanf.\n";
  }
  
  if (exists $blacklist{$1}) {
    return '';
  }
  
  return "http://search.cpan.org/src/" . $1;
}

# Given a CPAN::Module object, return the name of the distribution
sub distro_name {
  my $mod = shift;
  
  local $_ = $mod->cpan_file;
  m|.*/(.*)-.*\.tar\.gz$|;

  return $1;
}