r38592 - /scripts/cpan-unpackaged-deps.pl

[ryan52-guest at users.alioth.debian.org]

Author: ryan52-guest
Date: Thu Jun 25 10:06:33 2009
New Revision: 38592

URL: http://svn.debian.org/wsvn/?sc=1&rev=38592
Log:
add a script to map out unpackaged dependencies and generate a nice chart

Added:
    scripts/cpan-unpackaged-deps.pl   (with props)

Added: scripts/cpan-unpackaged-deps.pl
URL: http://svn.debian.org/wsvn/scripts/cpan-unpackaged-deps.pl?rev=38592&op=file
==============================================================================
--- scripts/cpan-unpackaged-deps.pl (added)
+++ scripts/cpan-unpackaged-deps.pl Thu Jun 25 10:06:33 2009
@@ -1,0 +1,117 @@
+#!/bin/perl
+
+package CPAN::Dist;
+
+use strict;
+use warnings;
+
+use Parse::CPAN::Meta;
+use DhMakePerl;
+
+our %modules;
+our %dists;
+our $dh_make_perl;
+
+sub init {
+  $dh_make_perl = DhMakePerl->new();
+  $dh_make_perl->cfg(DhMakePerl::Config->new());
+  $dh_make_perl->cfg->dist("sid");
+  my $f = `mktemp`;
+  chomp $f;
+  system("wget -q -O - http://cpan.hexten.net/modules/02packages.details.txt.gz | gunzip - | sed '1,/^\$/ d' > $f");
+  open F, $f;
+  while(<F>) {
+    my ($module, undef, $dist) = split(/\s+/, $_);
+    $modules{$module} = $dist;
+  }
+  close F;
+  unlink $f;
+}
+
+sub new {
+  my $class = shift;
+  my $self = {};
+  $self->{module} = shift;
+  bless $self, $class;
+  return if($self->packaged());
+  $self->{path} = $modules{$self->{module}};
+  return if(!$self->{path});
+  $self->{path} =~ /^.*\/(.*)-.*.(?:tar.gz|tgz)$/;
+  $self->{dist} = $1;
+  if(!$self->{dist}) {
+    print "ERROR: " . $self->{path} . "\n";
+  }
+  if(!$dists{$self->{dist}}) {
+    $self->initialize();
+    $dists{$self->{dist}} = $self;
+  }
+  return $dists{$self->{dist}};
+}
+
+sub initialize {
+  my $self = shift;
+  $self->{url} = "http://cpan.hexten.net/authors/id/" . $self->{path};
+  $self->{url} =~ s/(?:\.tar\.gz|tgz)$/.meta/;
+  my $f = `mktemp`;
+  chomp $f;
+  system("wget", "-q", "-O", $f, $self->{url});
+  $self->{meta} = Parse::CPAN::Meta::LoadFile($f);
+  unlink $f;
+  $self->make_deps();
+}
+
+sub make_deps {
+  my $self = shift;
+  my @requires = keys %{$self->{meta}->{requires}};
+  my @build_requires = keys %{$self->{meta}->{build_requires}};
+  my @deplist = (@requires, @build_requires);
+  my %deps_hash;
+  $deps_hash{$_} = 1 foreach(@deplist);
+  my @final_list = sort keys %deps_hash;
+  @{$self->{deps}} = map {ref($self)->new($_)} @final_list;
+  return $self->{deps};
+}
+
+sub packaged {
+  my $self = shift;
+  return "perl-modules" if($dh_make_perl->is_core_module($self->{module}));
+  return $dh_make_perl->get_apt_contents->find_perl_module_package($self->{module});
+}
+
+sub dists {
+  return %dists;
+}
+
+package main;
+
+use strict;
+use warnings;
+
+sub c {
+  my $str = shift;
+  $str =~ s/-/_/g;
+  return $str;
+}
+
+CPAN::Dist::init();
+my $dist = CPAN::Dist->new(shift);
+%dists = CPAN::Dist::dists();
+delete $dists{$dist->{dist}};
+my @a = ($dist, values %dists);
+my $f = `mktemp`;
+chomp $f;
+open OUT, ">", $f;
+print OUT "digraph G {\n";
+foreach(@a) {
+  my $dist = $_->{dist};
+  my @deps = @{$_->{deps}};
+  foreach(@deps) {
+    my $dep = $_->{dist};
+    print OUT "    " . c($dist) . " -> " . c($dep) . ";\n";
+  }
+}
+print OUT "}\n";
+close OUT;
+system("dot", "-Tpng", "-o", "output.png", $f);
+unlink $f;
+

Propchange: scripts/cpan-unpackaged-deps.pl
------------------------------------------------------------------------------
    svn:executable = *