[gentoo-commits] proj/perl-overlay:master commit in: scripts/lib/dep/handler/, scripts/, scripts/lib/, scripts/lib/dep/

[Kent Fredric]

commit:     ae542435b657a9af7585b4e4a977d2ba3d5797fc
Author:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
AuthorDate: Mon Oct 31 01:19:44 2011 +0000
Commit:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
CommitDate: Mon Oct 31 02:45:48 2011 +0000
URL:        http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=ae542435

overhauld and refactor deptree displayer

---
 scripts/lib/dep/handler/stdout.pm |  107 ++++++++++
 scripts/lib/dep/module.pm         |   34 ++++
 scripts/lib/dep/provided.pm       |   56 ++++++
 scripts/lib/dep/specialvs.pm      |   63 ++++++
 scripts/lib/dep/wanted.pm         |   40 ++++
 scripts/lib/deptools.pm           |  225 +++++++++++++++++++++
 scripts/show_deptree.pl           |  394 ++-----------------------------------
 7 files changed, 542 insertions(+), 377 deletions(-)

diff --git a/scripts/lib/dep/handler/stdout.pm b/scripts/lib/dep/handler/stdout.pm
new file mode 100644
index 0000000..a652da6
--- /dev/null
+++ b/scripts/lib/dep/handler/stdout.pm
@@ -0,0 +1,107 @@
+use strict;
+use warnings;
+
+package dep::handler::stdout;
+
+# FILENAME: stdout.pm
+# CREATED: 31/10/11 13:30:29 by Kent Fredric (kentnl) <kentfredric@×××××.com>
+# ABSTRACT: Dispatch dependency information to STDOUT.
+
+use Moose;
+has 'indent' => ( is => 'rw' );
+has 'tail'   => ( is => 'rw' );
+__PACKAGE__->meta->make_immutable;
+
+sub begin_dep {
+  my ( $self, $release, $module, $declaration ) = @_;
+  $self->indent(" \e[1;92m*");
+  $self->tail(" \e[1;92m-\n\n");
+  my $wantstring = $self->_want_string( $release, $module, $declaration );
+  return *STDOUT->printf( "\e[1;93m%s\e[0m\n", $wantstring );
+}
+
+sub evt_not_any {
+  my ( $self, $module, $declaration ) = @_;
+  return *STDOUT->printf( "%sWARNING: NO PROVIDER FOUND FOR \"%s\"%s\n", "\e[1;91m", $module, "\e[0m" );
+}
+
+sub evt_multi {
+  my ( $self, $module, $declaration ) = @_;
+  $self->indent(" \e[1;91m*");
+  $self->tail(" \e[1;91m-\n\n");
+
+  return *STDOUT->printf( "%sWARNING: MULTIPLE PROVIDERS FOUND FOR \"%s\"%s\n", "\e[1;91m", $module, "\e[0m" );
+}
+
+sub set_latest {
+  my ( $self, $dep, $pkg ) = @_;
+  return *STDOUT->printf( "%s\e[1;95m latest: %s => %s ( %s )\n", $self->indent, @{$dep}, $pkg );
+}
+
+sub _want_string {
+  my ( $self, $release, $module, $declaration ) = @_;
+  return $release . " -> " . $declaration->[2] . " " . $declaration->[3] . " " . $self->_depstring( $module, $declaration );
+}
+
+sub _depstring {
+  my ( $self, $module, $declaration ) = @_;
+
+  my $depstring = $module;
+
+  if ( $declaration->[1] ne '0.0.0' ) {
+    $depstring .= " " . $declaration->[0] . " ( " . $declaration->[1] . " ) ";
+  }
+  return $depstring;
+}
+
+sub _xwrap {
+  my $self = shift;
+  require Text::Wrap;
+  local $Text::Wrap::break    = qr/,/;
+  local $Text::Wrap::overflow = 'huge';
+  local $Text::Wrap::columns  = 128;
+  $Text::Wrap::overflow = 'huge';
+  my $pre = " ";
+  my $lines = Text::Wrap::wrap( $pre, $pre, @_ );
+  return $lines;
+}
+sub perl_dep {
+  my ( $self, $module, $declaration , $pkg ) = @_ ; 
+  *STDOUT->printf("%s %s%s -> %s%s\n", $self->indent, "\e[1;94m", $module, "\e[0m\e[94m", $pkg );
+}
+sub provider_group {
+  my ( $self, $data ) = @_;
+
+  my $want_string = $self->_want_string( $data->{release}, $data->{module}, $data->{declaration} );
+  my $depstring = $self->_depstring( $data->{module}, $data->{declaration} );
+
+  my $prefix = $depstring . ' in ' . $data->{provider};
+
+  my $lines = $self->_xwrap( join q[, ], @{ $data->{versions} } );
+  my (@slines) = split /$/m, $lines;
+  $_ =~ s/[\r\n]*//m for @slines;
+
+  *STDOUT->printf( " %s%s -> %s%s (%s)\n", "\e[1;92m", $depstring, "\e[0m\e[92m", $data->{provider}, $data->{gentoo_pkg} );
+  *STDOUT->printf( "%s newest: %s\e[0m\n", $self->indent, $data->{newest} );
+  *STDOUT->printf( "%s oldest: %s\e[0m\n", $self->indent, $data->{oldest} );
+
+  my $v = $data->{closest};
+  if ( not $data->{has_closest} ) { $v = 'undef' }
+
+  *STDOUT->printf( "%s closest: %s\e[0m\n", $self->indent, $v );
+
+  for (@slines) {
+    *STDOUT->printf( "%s %s%s -> %s%s\n", $self->indent, "\e[1;94m", $data->{provider}, "\e[0m\e[94m", $_ );
+  }
+
+}
+
+sub done {
+  my ( $self, $module, $declaration ) = @_;
+  return *STDOUT->print( $self->tail );
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+1;
+

diff --git a/scripts/lib/dep/module.pm b/scripts/lib/dep/module.pm
new file mode 100644
index 0000000..26f5fe6
--- /dev/null
+++ b/scripts/lib/dep/module.pm
@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+
+package dep::module;
+
+# FILENAME: module.pm
+# CREATED: 31/10/11 13:44:00 by Kent Fredric (kentnl) <kentfredric@×××××.com>
+# ABSTRACT: A dependency record for a single module
+
+use Moose;
+
+has 'name'           => ( isa => "Str",        required   => 1,    is       => 'rw', );
+has 'version_string' => ( isa => 'Maybe[Str]', is         => 'rw', init_arg => 'version', predicate => 'has_version_string' );
+has 'version'        => ( is  => 'rw',         lazy_build => 1,    init_arg => undef );
+has 'parent'         => ( is  => 'rw',         required   => 1,    weak_ref => 1 );
+
+sub _build_version {
+  require version;
+  my $self = shift;
+  return version->parse( $self->version_string );
+}
+
+sub debug_string {
+  my $self = shift;
+  return sprintf '%s ( %s ) => %s', $self->parent->version,
+    $self->parent->can_gv ? $self->parent->gv : 'undef',
+    $self->has_version_string ? '"' . $self->version_string . '"' : 'undef';
+}
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+1;
+

diff --git a/scripts/lib/dep/provided.pm b/scripts/lib/dep/provided.pm
new file mode 100644
index 0000000..19c058e
--- /dev/null
+++ b/scripts/lib/dep/provided.pm
@@ -0,0 +1,56 @@
+use strict;
+use warnings;
+
+package dep::provided;
+
+# FILENAME: provided.pm
+# CREATED: 31/10/11 13:42:24 by Kent Fredric (kentnl) <kentfredric@×××××.com>
+# ABSTRACT: repesents a provided package
+
+use Moose;
+require dep::module;
+
+has 'distribution' => ( isa => 'Defined', is => 'rw', required => 1 );
+has 'version'  => ( is  => 'rw',       required   => 1 );
+has 'maturity' => ( is  => 'rw',       required   => 1 );
+has 'status'   => ( is  => 'rw',       required   => 1 );
+has 'gv'       => ( is  => 'rw',       lazy_build => 1 );
+has '_modules' => ( isa => 'ArrayRef', required   => 1, init_arg => '_source.module', is => 'rw', );
+has 'modules' => ( isa => 'ArrayRef[dep::module]', lazy_build => 1, is => 'rw' );
+
+__PACKAGE__->meta->make_immutable;
+
+sub _build_modules {
+  my $self = shift;
+  return [ map { dep::module->new( %{$_}, parent => $self ) } @{ $self->_modules } ];
+}
+
+sub _build_gv {
+  require Gentoo::PerlMod::Version;
+  use Try::Tiny;
+  my ($self) = @_;
+  my $v;
+  try {
+    $v = Gentoo::PerlMod::Version::gentooize_version( $self->version, { lax => 1 } );
+  }
+  catch {
+    $v = undef;
+  };
+  return $v;
+}
+
+sub can_gv {
+  return defined $_[0]->gv;
+}
+
+sub is_dev {
+  return $_[0]->maturity eq 'development';
+}
+
+sub is_backpan {
+  return $_[0]->status eq 'backpan';
+}
+
+no Moose;
+1;
+

diff --git a/scripts/lib/dep/specialvs.pm b/scripts/lib/dep/specialvs.pm
new file mode 100644
index 0000000..19b6ff5
--- /dev/null
+++ b/scripts/lib/dep/specialvs.pm
@@ -0,0 +1,63 @@
+use strict;
+use warnings;
+
+package dep::specialvs;
+
+# FILENAME: specialvs.pm
+# CREATED: 31/10/11 13:38:14 by Kent Fredric (kentnl) <kentfredric@×××××.com>
+# ABSTRACT: Collect special version information about a dependency
+
+use Moose;
+
+has newest  => ( isa => 'HashRef', default => sub { {} }, is => 'rw' );
+has newestx => ( isa => 'HashRef', default => sub { {} }, is => 'rw' );
+
+has oldest  => ( isa => 'HashRef', default => sub { {} }, is => 'rw' );
+has oldestx => ( isa => 'HashRef', default => sub { {} }, is => 'rw' );
+
+has closest  => ( isa => 'HashRef', default => sub { {} }, is => 'rw' );
+has closestx => ( isa => 'HashRef', default => sub { {} }, is => 'rw' );
+
+has latest  => ( is => 'rw', predicate => 'has_latest' );
+has latestx => ( is => 'rw', predicate => 'has_latestx' );
+
+sub set_latest_mod {
+  my ( $self, $provider, $mod ) = @_;
+  return if $self->has_latest;
+  $self->latest( [ $provider, $mod->debug_string ] );
+  $self->latestx( [ $provider, $mod ] );
+}
+
+sub set_newest_mod {
+  my ( $self, $key, $mod ) = @_;
+  return if exists $self->newest->{$key};
+  $self->newest->{$key}  = $mod->debug_string;
+  $self->newestx->{$key} = $mod;
+}
+
+sub set_oldest_mod {
+  my ( $self, $key, $mod ) = @_;
+
+  $self->oldest->{$key}  = $mod->debug_string;
+  $self->oldestx->{$key} = $mod;
+}
+
+sub set_closest_mod {
+  my ( $self, $key, $mod ) = @_;
+  if ( not defined $self->closestx->{$key} ) {
+    $self->closestx->{$key} = $mod;
+    $self->closest->{$key}  = $mod->debug_string;
+    return;
+  }
+  if ( $self->closestx->{$key}->version >= $mod->version ) {
+    $self->closestx->{$key} = $mod;
+    $self->closest->{$key}  = $mod->debug_string;
+  }
+  return;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+1;
+

diff --git a/scripts/lib/dep/wanted.pm b/scripts/lib/dep/wanted.pm
new file mode 100644
index 0000000..f2b13c6
--- /dev/null
+++ b/scripts/lib/dep/wanted.pm
@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+
+package dep::wanted;
+
+# FILENAME: wanted.pm
+# CREATED: 31/10/11 13:45:03 by Kent Fredric (kentnl) <kentfredric@×××××.com>
+# ABSTRACT: a record for something wanted to be a dep
+
+use Moose;
+has [qw( module version_string )] => ( isa => 'Str', is => 'rw', 'required' => 1 );
+has [qw( gentoo_version version )] => ( is => 'rw', lazy_build => 1 );
+
+sub _build_gentoo_version {
+  my $self = shift;
+  require Gentoo::PerlMod::Version;
+  return Gentoo::PerlMod::Version::gentooize_version( $self->version_string );
+}
+
+sub _build_version {
+  my $self = shift;
+  require version;
+  return version->parse( $self->version_string );
+}
+
+sub no_version_dep {
+  return not defined $_[0]->version_string;
+}
+
+sub provides {
+  require metacpan;
+  my $self = shift;
+  require dep::provided;
+  return map { dep::provided->new( %{$_} ) } metacpan->find_dist_simple( $self->module );
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+1;
+

diff --git a/scripts/lib/deptools.pm b/scripts/lib/deptools.pm
new file mode 100644
index 0000000..a4cdc51
--- /dev/null
+++ b/scripts/lib/deptools.pm
@@ -0,0 +1,225 @@
+use 5.010000;
+use strict;
+use warnings;
+
+package deptools;
+
+# FILENAME: deptools.pm
+# CREATED: 31/10/11 09:30:24 by Kent Fredric (kentnl) <kentfredric@×××××.com>
+# ABSTRACT: Miscelanous bits for computing deps for Perl modules
+
+sub virtual($) { return 'virtual/perl-' . shift }
+sub lang($)    { return 'dev-lang/' . shift }
+
+sub _vmap_langs {
+  return ( 'perl', 'perl_debug', );
+}
+
+sub _vmap_perl_native {
+  return (
+    'Archive-Tar',       'Attribute-Handlers',   'AutoLoader',           'CGI',
+    'Class-ISA',         'Compress-Raw-Bzip2',   'Compress-Raw-Zlib',    'CPAN-Meta',
+    'CPAN-Meta-YAML',    'Data-Dumper',          'DB_File',              'Digest-MD5',
+    'Digest-SHA',        'Encode',               'ExtUtils-CBuilder',    'ExtUtils-Command',
+    'ExtUtils-Install',  'ExtUtils-MakeMaker',   'ExtUtils-Manifest',    'ExtUtils-ParseXS',
+    'File-Path',         'File-Temp',            'Filter',               'Getopt-Long',
+    'i18n-langtags',     'IO',                   'IO-Compress',          'IO-Zlib',
+    'IPC-Cmd',           'JSON-PP',              'libnet',               'Locale-MakeText-Simple',
+    'Math-BigInt',       'Math-BigInt-FastCalc', 'Memoize',              'MIME-Base64',
+    'Module-Build',      'Module-CoreList',      'Module-Load',          'Module-Load-Conditional',
+    'Module-Loaded',     'Module-Metadata',      'Module-Pluggable',     'Package-Constants',
+    'Params-Check',      'parent',               'Parse-CPAN-Meta',      'Perl-OSType',
+    'Pod-Escapes',       'podlators',            'Pod-Simple',           'Safe',
+    'Scalar-List-Utils', 'Storable',             'Switch',               'Sys-Syslog',
+    'Term-ANSIColor',    'Test',                 'Test-Harness',         'Test-Simple',
+    'Text-Balanced',     'Text-Tabs+Wrap',       'Thread-Queue',         'threads',
+    'Thread-Semaphore',  'threads-shared',       'Time-HiRes',           'Time-Local',
+    'Time-Piece',        'version',              'Version-Requirements', 'XSLoader',
+  );
+}
+
+sub _vmap_perl_strange {
+  return (
+    'Digest'          => virtual 'digest-base',
+    'PathTools'       => virtual 'File-Spec',
+    'Locale-MakeText' => virtual 'locale-maketext',
+    'Net-Ping'        => virtual 'net-ping',
+    'Pod-Parser'      => virtual 'PodParser',
+  );
+}
+
+sub _vmap_overlay_native {
+  return (
+    'Archive-Extract',    'B-Debug',             'B-Lint',             'constant',     'CPAN',
+    'CPANPLUS',           'CPANPLUS-Dist-Build', 'Devel-DProf',        'Devel-PPPort', 'Devel-SelfStubber',
+    'Dumpvalue',          'ExtUtils-Constant',   'ExtUtils-MakeMaker', 'File-Fetch',   'Filter-Simple',
+    'HTTP-Tiny',          'i18n-langtags',       'if',                 'IPC-SysV',     'Log-Message',
+    'Log-Message-Simple', 'Math-Complex',        'Module-CoreList',    'NEXT',         'Object-Accessor',
+    'Pod-LaTeX',          'Pod-Perldoc',         'Pod-Plainer',        'SelfLoader',   'Term-UI',
+    'Unicode-Collate',    'Unicode-Normalize',
+  );
+}
+
+sub _vmap {
+  return (
+    ( map { $_, lang $_ } _vmap_langs() ),
+    ( map { $_, virtual $_ } _vmap_perl_native(), _vmap_overlay_native() ),
+    _vmap_perl_strange(),
+  );
+}
+
+sub gentooize_pkg {
+  my ( $pkg, $version ) = @_;
+  state $vmap = { _vmap() };
+  my $outpkg = 'dev-perl/' . $pkg;
+  if ( exists $vmap->{$pkg} ) {
+    $outpkg = $vmap->{$pkg};
+  }
+  if ( not $version or $version eq '0.0.0' ) {
+    return $outpkg;
+  }
+  return '\\>=' . $outpkg . '-' . $version;
+}
+
+sub provider_map {
+
+  require dep::wanted;
+  my $wanted = dep::wanted->new(
+    module         => $_[0],
+    version_string => $_[1],
+  );
+  my @providers = $wanted->provides;
+
+  my %moduleprov;
+
+  require dep::specialvs;
+  my $specialvs = dep::specialvs->new();
+
+
+  for my $provider (@providers) {
+  
+    next if $provider->is_backpan;
+    next if $provider->is_dev;
+
+    next unless $provider->can_gv;
+
+    my @provided_matching_mods;
+    for my $mod ( @{ $provider->modules } ) {
+
+      next unless $mod->name eq $wanted->module;
+
+      # specials
+      $specialvs->set_latest_mod( $provider->distribution , $mod );
+      $specialvs->set_newest_mod( $provider->distribution, $mod  );
+      $specialvs->set_oldest_mod( $provider->distribution, $mod );
+
+      if ( $wanted->no_version_dep or $mod->version >= $wanted->version ) {
+        $specialvs->set_closest_mod( $provider->distribution, $mod );
+      }
+
+      push @provided_matching_mods, $mod->debug_string
+        if $mod->name eq $wanted->module;
+    }
+    $moduleprov{ $provider->distribution } //= [];
+    push @{ $moduleprov{ $provider->distribution } }, @provided_matching_mods;
+  }
+  return \%moduleprov, $specialvs;
+}
+sub get_deps {
+  my ($release) = shift;
+
+  my ( $author, $distrelease );
+
+  $release =~ qr{^([^/]+)/(.*$)};
+  ( $author, $distrelease ) = ( "$1", "$2" );
+  require metacpan;
+  return metacpan->find_release( $author, $distrelease );
+}
+
+sub get_dep_phases {
+  my ($release) = shift;
+  my %phases;
+  my %modules;
+  my ( $result, ) = get_deps($release);
+  for my $dep ( @{ $result->{dependency} } ) {
+    my $phase    = $dep->{phase};
+    my $module   = $dep->{module};
+    my $required = ( $dep->{relationship} eq 'requires' );
+
+    next unless $required;
+    next if $phase eq 'develop';
+
+    $phases{$phase}   //= [];
+    $modules{$module} //= [];
+  
+    require Gentoo::PerlMod::Version;
+    my $v = Gentoo::PerlMod::Version::gentooize_version( $dep->{version}, { lax => 1 } );
+
+    push @{ $phases{$phase} }, [ $dep->{module}, $dep->{version}, $v, $dep->{relationship} ];
+    push @{ $modules{$module} }, [ $dep->{version}, $v, $dep->{phase}, $dep->{relationship} ];
+  }
+  return { phases => \%phases, modules => \%modules };
+}
+
+sub dispatch_dependency_handler {
+  
+  my ( $release, $module, $declaration, $feeder ) = @_;
+
+  my ( $moduleprov, $specialvs ) = provider_map( $module, $declaration->[0] );
+
+  my $pc = scalar keys %$moduleprov;
+
+  my $multi = ( $pc > 1 );
+  my $any   = ( $pc > 0 );
+
+  $feeder->begin_dep( $release, $module, $declaration );
+
+
+  if( $module eq 'perl' ){ 
+    $feeder->perl_dep( $module, $declaration , gentooize_pkg( 'perl', $declaration->[1] ));
+    return $feeder->done;
+  }
+
+  if ( not $any ) { $feeder->evt_not_any( $module, $declaration ); }
+
+  if ($multi) { $feeder->evt_multi( $module, $declaration ); }
+
+  #pp { 
+  #  moduleprov => $moduleprov, 
+  #  specialvs => $specialvs,
+  #  release => $release,
+  #  module => $module, 
+  #  declaration => $declaration,
+  #  latest => $specialvs->latest,
+  #};
+  if( $specialvs->has_latest ) {
+    $feeder->set_latest( $specialvs->latest, 
+    gentooize_pkg( $specialvs->latest->[0],
+      $declaration->[1] ) 
+    );
+  }
+
+  for my $prov ( keys %{$moduleprov} ) {
+
+    my $data = {
+      release     => $release,
+      versions    => $moduleprov->{$prov},
+      provider    => $prov,
+      gentoo_pkg  => gentooize_pkg($prov),
+      newest      => $specialvs->newest->{$prov},
+      newestx     => $specialvs->newestx->{$prov},
+      oldest      => $specialvs->oldest->{$prov},
+      oldestx     => $specialvs->oldestx->{$prov},
+      has_closest => exists $specialvs->closest->{$prov},
+      closest     => $specialvs->closest->{$prov},
+      closestx    => $specialvs->closestx->{$prov},
+      declaration => $declaration,
+      module      => $module,
+    };
+    $feeder->provider_group($data);
+  }
+  $feeder->done( $module, $declaration );
+
+}
+1;
+

diff --git a/scripts/show_deptree.pl b/scripts/show_deptree.pl
index e49728d..ef6d8e7 100755
--- a/scripts/show_deptree.pl
+++ b/scripts/show_deptree.pl
@@ -9,10 +9,7 @@ use warnings;
 use FindBin;
 use lib "$FindBin::Bin/lib";
 use env::gentoo::perl_experimental;
-use metacpan qw( mcpan );
 use utf8;
-use Gentoo::PerlMod::Version qw( gentooize_version );
-use Text::Wrap;
 
 my $flags;
 my $singleflags;
@@ -37,389 +34,45 @@ if ( $flags->{help} or $singleflags->{h} ) { print help(); exit 0; }
 #
 # gen_ebuild.pl DOY/Moose-2.0301-TRIAL
 #
-my ($release) = shift(@ARGV);
-
-*STDOUT->binmode(':utf8');
-*STDERR->binmode(':utf8');
-
-my %phases;
-my %modules;
-my %providers;
-
-my $dep_phases = get_dep_phases($release);
-%phases  = %{ $dep_phases->{phases} };
-%modules = %{ $dep_phases->{modules} };
-
-use Data::Dump qw( pp );
-use JSON qw( to_json encode_json );
-use Try::Tiny;
-use version ();
-
-sub provider_map {
-  my ( $module, $version ) = @_;
-  my @providers = metacpan->find_dist_simple($module);
-  my %moduleprov;
-
-  my %specialvs;
-
-  my $wanted_version = version->parse($version);
-
-  for my $provider (@providers) {
-
-    #next if $provider->{status}   eq 'backpan';
-    next if $provider->{maturity} eq 'developer';
-
-    #    pp $provider;
-
-    my $dist  = $provider->{distribution};
-    my $distv = $provider->{version} // 'undef';
-    my $gv    = 'undef';
-    if ( $distv ne 'undef' ) {
-      try {
-        $gv = gentooize_version( $distv, { lax => 1 } );
-      }
-      catch {
-        $gv = '???';
-      };
-    }
-
-    #next if $gv eq '???';
-
-    $moduleprov{$dist} //= [];
-
-    my @provided_matching_mods;
-    for my $mod ( @{ $provider->{'_source.module'} } ) {
-      next unless $mod->{name} eq $module;
-      my $modv = $mod->{version} // 'undef';
-
-      my $got_version = version->parse( $mod->{version} );
-
-      my $dv = $distv;
-      $dv = sprintf "%s ( %s ) => \"%s\"", $distv, $gv, $modv;
-
-      # specials
-
-      $specialvs{newest}   //= {};
-      $specialvs{oldest}   //= {};
-      $specialvs{closest}  //= {};
-      $specialvs{closestx} //= {};
-      $specialvs{latest} = [ $dist, $dv ] if not exists $specialvs{latest};
-      $specialvs{newest}->{$dist} = $dv if not exists $specialvs{newest}->{$dist};
-      $specialvs{oldest}->{$dist} = $dv;
-
-      if ( not defined $version or $got_version >= $wanted_version ) {
-
-        if ( not defined $specialvs{closestx}->{$dist} ) {
-          $specialvs{closestx}->{$dist} = $got_version;
-          $specialvs{closest}->{$dist}  = $dv;
-        }
-        else {
-          if ( $specialvs{closestx}->{$dist} >= $got_version ) {
-            $specialvs{closestx}->{$dist} = $got_version;
-            $specialvs{closest}->{$dist}  = $dv;
-          }
-        }
-      }
-
-      #
-
-      push @provided_matching_mods, $dv
-        if $mod->{name} eq $module;
-    }
-    push @{ $moduleprov{$dist} }, @provided_matching_mods;
-  }
-  return \%moduleprov, \%specialvs;
-}
-
-sub handle_declaration {
-  my ( $release, $module, $declaration, $output ) = @_;
-
-  my $depstring = $module;
-  if ( $declaration->[1] ne '0.0.0' ) {
-    $depstring .= " " . $declaration->[0] . " ( " . $declaration->[1] . " ) ";
-  }
-
-  my $want_string = "$release -> " . $declaration->[2] . " " . $declaration->[3] . " " . $depstring;
-
-  my ( $moduleprov, $specialvs ) = provider_map( $module, $declaration->[0] );
-
-  my $to_pkg = sub {
-    my $pkg  = shift;
-    my $xpkg = gentooize_pkg($pkg);
-    if ( $declaration->[1] eq '0.0.0' ) {
-      return $xpkg;
-    }
-    return '\\>=' . $xpkg . '-' . $declaration->[1];
-  };
-
-  my $pc = scalar keys %$moduleprov;
-
-  my $multi = ( $pc > 1 );
-  my $any   = ( $pc > 0 );
-
-  $output->printf( "\e[1;93m%s\e[0m\n", $want_string );
-
-  if ( not $any ) {
-    return $output->printf( "%sWARNING: NO PROVIDER FOUND FOR \"%s\"%s\n", "\e[1;91m", $module, "\e[0m" );
-  }
-  if ($multi) {
-    $output->printf( "%sWARNING: MULTIPLE PROVIDERS FOUND FOR \"%s\"%s\n", "\e[1;91m", $module, "\e[0m" );
-  }
-
-  my $indent = " \e[1;92m*";
-  $indent = " \e[1;91m*" if $multi;
-
-  $output->printf(
-    "%s\e[1;95m latest: %s => %s ( %s )\n",
-    $indent,
-    @{ $specialvs->{latest} },
-    $to_pkg->( $specialvs->{latest}->[0] )
-  );
-
-  for my $prov ( keys %{$moduleprov} ) {
-    my $prefix = $depstring . ' in ' . $prov;
-    my $lines = xwrap( join q[, ], @{ $moduleprov->{$prov} } );
-    my (@slines) = split /$/m, $lines;
-    $_ =~ s/[\r\n]*//m for @slines;
-    $output->printf( " %s%s -> %s%s (%s)\n", "\e[1;92m", $depstring, "\e[0m\e[92m", $prov, gentooize_pkg($prov) );
-    $output->printf( "%s newest: %s\e[0m\n", $indent, $specialvs->{newest}->{$prov} );
-    $output->printf( "%s oldest: %s\e[0m\n", $indent, $specialvs->{oldest}->{$prov} );
-    my $v = $specialvs->{closest}->{$prov};
-    if ( not defined $v ) { $v = 'undef' }
-    $output->printf( "%s closest: %s\e[0m\n", $indent, $v );
-
-    for (@slines) {
+sub help {
+  return <<'EOF';
+gen_ebuild.pl
 
-      $output->printf( "%s %s%s -> %s%s\n", $indent, "\e[1;94m", $prov, "\e[0m\e[94m", $_ );
-    }
-  }
-  if ($multi) {
-    $output->print(" \e[1;91m-\n\n");
-  }
-  else {
-    $output->print(" \e[1;92m-\n\n");
-  }
+USAGE:
 
-}
+  show_deptree.pl DOY/Moose-2.0301-TRIAL
 
-sub virtual($) {
-  my $i = shift;
-  return 'virtual/perl-' . $i;
+EOF
 }
+my ($release) = shift(@ARGV);
 
-sub gentooize_pkg {
-  my $pkg  = shift;
-  my %vmap = (
-    'perl'       => 'dev-lang/perl',
-    'perl_debug' => 'dev-lang/perl_debug',    # doesn't actually exist
-    (
-      map { $_, virtual $_ }
-        qw(
-        Archive-Tar
-        Attribute-Handlers
-        AutoLoader
-        CGI
-        Class-ISA
-        Compress-Raw-Bzip2
-        Compress-Raw-Zlib
-        CPAN-Meta
-        CPAN-Meta-YAML
-        Data-Dumper
-        DB_File
-        Digest-MD5
-        Digest-SHA
-        Encode
-        ExtUtils-CBuilder
-        ExtUtils-Command
-        ExtUtils-Install
-        ExtUtils-MakeMaker
-        ExtUtils-Manifest
-        ExtUtils-ParseXS
-        File-Path
-        File-Temp
-        Filter
-        Getopt-Long
-        i18n-langtags
-        IO
-        IO-Compress
-        IO-Zlib
-        IPC-Cmd
-        JSON-PP
-        libnet
-        Locale-MakeText-Simple
-        Math-BigInt
-        Math-BigInt-FastCalc
-        Memoize
-        MIME-Base64
-        Module-Build
-        Module-CoreList
-        Module-Load
-        Module-Load-Conditional
-        Module-Loaded
-        Module-Metadata
-        Module-Pluggable
-        Package-Constants
-        Params-Check
-        parent
-        Parse-CPAN-Meta
-        Perl-OSType
-        Pod-Escapes
-        podlators
-        Pod-Simple
-        Safe
-        Scalar-List-Utils
-        Storable
-        Switch
-        Sys-Syslog
-        Term-ANSIColor
-        Test
-        Test-Harness
-        Test-Simple
-        Text-Balanced
-        Text-Tabs+Wrap
-        Thread-Queue
-        threads
-        Thread-Semaphore
-        threads-shared
-        Time-HiRes
-        Time-Local
-        Time-Piece
-        version
-        Version-Requirements
-        XSLoader
-        )
-    ),
-    'Digest'          => virtual 'digest-base',
-    'PathTools'       => virtual 'File-Spec',
-    'Locale-MakeText' => virtual 'locale-maketext',
-    'Net-Ping'        => virtual 'net-ping',
-    'Pod-Parser'      => virtual 'PodParser',
-    ## Overlay
-    (
-      map { $_, virtual $_ }
-        qw(
-        Archive-Extract
-        B-Debug
-        B-Lint
-        constant
-        CPAN
-        CPANPLUS
-        CPANPLUS-Dist-Build
-        Devel-DProf
-        Devel-PPPort
-        Devel-SelfStubber
-        Dumpvalue
-        ExtUtils-Constant
-        ExtUtils-MakeMaker
-        File-Fetch
-        Filter-Simple
-        HTTP-Tiny
-        i18n-langtags
-        if
-        IPC-SysV
-        Log-Message
-        Log-Message-Simple
-        Math-Complex
-        Module-CoreList
-        NEXT
-        Object-Accessor
-        Pod-LaTeX
-        Pod-Perldoc
-        Pod-Plainer
-        SelfLoader
-        Term-UI
-        Unicode-Collate
-        Unicode-Normalize
-        )
-    ),
-  );
+*STDOUT->binmode(':utf8');
+*STDERR->binmode(':utf8');
 
-  if ( exists $vmap{$pkg} ) {
-    return $vmap{$pkg};
-  }
-  return 'dev-perl/' . $pkg;
-}
+require deptools;
+my $dep_phases = deptools::get_dep_phases($release);
 
 my @queue;
 
-for my $module ( keys %modules ) {
-  for my $declaration ( @{ $modules{$module} } ) {
+for my $module ( keys %{ $dep_phases->{modules} } ) {
+  for my $declaration ( @{ $dep_phases->{modules}->{$module} } ) {
     push @queue, [ $module, $declaration ];
   }
 }
 my @squeue =
   sort { $a->[1]->[2] cmp $b->[1]->[2] or $a->[1]->[3] cmp $b->[1]->[3] or $a->[0] cmp $b->[0] } @queue;
 
+require dep::handler::stdout;
+my $handler = dep::handler::stdout->new();
+
 for my $qi (@squeue) {
-  handle_declaration( $release, @{$qi}, *STDOUT );
+  deptools::dispatch_dependency_handler( $release, @{$qi}, $handler );
 }
 
-use Data::Dump qw( pp );
-use JSON qw( to_json encode_json );
-
 #say pp( \%modules,);# { pretty => 1 } );
 exit 1;
 
-sub xwrap {
-  local $Text::Wrap::break    = qr/,/;
-  local $Text::Wrap::overflow = 'huge';
-  local $Text::Wrap::columns  = 128;
-  $Text::Wrap::overflow = 'huge';
-  my $pre = " ";
-  my $lines = wrap( $pre, $pre, @_ );
-  return $lines;
-}
-
-sub clines {
-  my ( $c, $prefix, $lines ) = @_;
-  $lines =~ s/^/$prefix>>$c/mg;
-  $lines =~ s/$/\e[0m/mg;
-  return $lines;
-}
-
-sub get_dep_phases {
-  my ($release) = shift;
-  my %phases;
-  my %modules;
-  my ( $result, ) = get_deps($release);
-  for my $dep ( @{ $result->{dependency} } ) {
-    my $phase    = $dep->{phase};
-    my $module   = $dep->{module};
-    my $required = ( $dep->{relationship} eq 'requires' );
-
-    next unless $required;
-    next if $phase eq 'develop';
 
-    $phases{$phase}   //= [];
-    $modules{$module} //= [];
-
-    my $v = gentooize_version( $dep->{version}, { lax => 1 } );
-
-    push @{ $phases{$phase} }, [ $dep->{module}, $dep->{version}, $v, $dep->{relationship} ];
-    push @{ $modules{$module} }, [ $dep->{version}, $v, $dep->{phase}, $dep->{relationship} ];
-  }
-  return { phases => \%phases, modules => \%modules };
-}
-
-sub to_curl {
-  my ( $target, $query ) = @_;
-
-  my $query_json = to_json( $query, { pretty => 1 } );
-  print 'curl -XPOST api.metacpan.org/v0/' . $target . '/_search -d \'';
-  print $query_json;
-  print qq{'\n};
-
-}
-
-sub get_deps {
-  my ($release) = shift;
-
-  my ( $author, $distrelease );
-
-  $release =~ qr{^([^/]+)/(.*$)};
-  ( $author, $distrelease ) = ( "$1", "$2" );
-  return metacpan->find_release( $author, $distrelease );
-}
 
 sub pkg_for_module {
   my ($module) = shift;
@@ -432,17 +85,4 @@ sub gen_dep {
 
 }
 
-sub help {
-  return <<'EOF';
-gen_ebuild.pl
-
-USAGE:
 
-  gen_ebuild.pl DOY/Moose-2.0301-TRIAL
-
-  edit ./Moose-2.30.100_rc.ebuild 
-
-  done!
-
-EOF
-}