Re: Module index tree for POE?

[Rocco Caputo]

On Thu, Jul 17, 2003 at 12:38:21AM -0400, Rocco Caputo wrote:
> I've attached source for it.

I didn't, but now I am.  Honest this time.

-- Rocco Caputo - [EMAIL PROTECTED] - http://poe.perl.org/

#!/usr/bin/perl
# $Id$

# Build a tree of POE modules.

use warnings;
use strict;

use CPANPLUS::Backend;
use CPANPLUS::Configure;
use Cwd;

# Local configuration.  The directories share files with
# lib/cpan-test.perl.

my $cwd = cwd;
sub DIR_MAIN     () { $cwd . "/comptest" }
sub DIR_CPANPLUS () { DIR_MAIN . "/cpanplus" }

# Create directories as necessary.

unless (-e DIR_MAIN) {
  mkdir DIR_MAIN, 0777 or die $!;
}

unless (-e DIR_CPANPLUS) {
  mkdir DIR_CPANPLUS, 0777 or die $!;
}

# Grab CPANPLUS' configuration, and locally redirect its base
# directory to our own location.

my $cc = CPANPLUS::Configure->new();
$cc->_set_build( base => DIR_CPANPLUS );

# Gather a list of POE distributions on the CPAN, and build a tree out
# of their namespaces.

my $cp = CPANPLUS::Backend->new($cc);
my $search = $cp->search(
  type => "module",
  list => [ "^POE::" ],
);

my %package;
my %mod_obj;

foreach my $mod (sort keys %$search) {
  my $obj = $search->{$mod};
  my $package = $obj->package();

  my ($pkg, $ver) = ($package =~ /^(.*?)-([0-9\.\_]+)\.tar\.gz$/);
  next unless $pkg;

  $mod_obj{$pkg} = $obj;

  my @pkg = split /-/, $pkg;

  my $cursor = \%package;
  while (@pkg) {
    my $next = shift @pkg;
    unless (exists $cursor->{$next}) {
      $cursor->{$next} = {};
    }
    $cursor = $cursor->{$next};
  }
}

# Recursively walk the namespace tree, and display it prettily.

sub walk_branch {
  my ($name, $level, $hash) = @_;

  my @name = @$name;
  push @name, "";

  my @branches = sort keys %$hash;
  foreach (@branches) {
    $name[-1] = $_;
    my $hash_key = join("-", @name);
    my $branch = ("| " x $level) . $_;

    my $desc = "";
    if (exists $mod_obj{$hash_key}) {
      $desc = $mod_obj{$hash_key}->description();
      $desc = "(none)" unless defined $desc and length $desc;
    }

    print $branch;
    if (length $desc) {
      print " " x (20 - length($branch));
      print " - $desc";
    }
    print "\n";

    walk_branch([EMAIL PROTECTED], $level+1, $hash->{$_});
  }
}

walk_branch([], 0, \%package);