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

[Kent Fredric]

commit:     f425f8c63cced5fcac32e7c7d1367b2655a93201
Author:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
AuthorDate: Sun Feb 26 01:49:24 2012 +0000
Commit:     Kent Fredric <kentfredric <AT> gmail <DOT> com>
CommitDate: Sun Feb 26 02:26:00 2012 +0000
URL:        http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=f425f8c6

[scripts/gen_ebuild.pl] Improve non-debug mode tracing, remove warning errors, show deps early, skip resolving recommended deps as we dont codify them at present anyway

---
 scripts/gen_ebuild.pl                    |   46 +++++++++++----
 scripts/lib/dep/handler/stdout/simple.pm |   93 ++++++++++++++++++++++++++++++
 2 files changed, 126 insertions(+), 13 deletions(-)

diff --git a/scripts/gen_ebuild.pl b/scripts/gen_ebuild.pl
index ab0dc2d..2d9d1e5 100755
--- a/scripts/gen_ebuild.pl
+++ b/scripts/gen_ebuild.pl
@@ -17,7 +17,7 @@ my $flags;
 my $singleflags;
 
 @ARGV = grep { defined } map {
-  $_ =~ /^--(\w+)/
+  $_ =~ /^--(.+)/
     ? do { $flags->{$1}++; undef }
     : do {
     $_ =~ /^-(\w+)/
@@ -26,6 +26,11 @@ my $singleflags;
     }
 } @ARGV;
 
+for my $k ( keys %{$flags} ) {
+  if ( $k =~ /^([^=]+)=(.*$)/ ) {
+    $flags->{$1} = $2;
+  }
+}
 if ( $flags->{help} or $singleflags->{h} ) { print help(); exit 0; }
 
 # FILENAME: show_deptree.pl
@@ -74,11 +79,22 @@ if ( not $release_info ) {
   die "Cannot find $release on MetaCPAN";
 }
 my $dep_phases = deptools::get_dep_phases($release);
+pp( $dep_phases->{phases} );
 
+#warn "Found $#{$dep_phases} phases";
 my @queue;
 
 for my $module ( keys %{ $dep_phases->{modules} } ) {
   for my $declaration ( @{ $dep_phases->{modules}->{$module} } ) {
+    if ( $declaration->[3] eq 'recommends' ) {
+      warn "skipped dep on recommended module $module";
+      next;
+    }
+    if ( $declaration->[3] eq 'suggests' ) {
+      warn "skipped dep on suggested module $module";
+      next;
+    }
+
     push @queue, [ $module, $declaration ];
   }
 }
@@ -88,21 +104,25 @@ my @squeue =
 require dep::handler::bashcode;
 
 my $handler;
+my $hc = 'dep::handler::stdout::simple';
 
-if ( defined $flags->{debug} and ( $flags->{debug} ne "1" or $flags->{debug} ne "2" ) ) {
-  $flags->{debug} = 1;
+if ( defined $flags->{debug} ) {
+  if ( $flags->{debug} eq "1" ) {
+    $hc = 'dep::handler::stdout::terse';
+  }
+  elsif ( $flags->{debug} eq "2" ) {
+    $hc = 'dep::handler::stdout';
+  }
+  else {
+    $hc = 'dep::handler::stdout::terse';
+  }
 }
 
-if ( $flags->{debug} == 1 ) {
-  require dep::handler::stdout::terse;
-  $handler = dep::handler::stdout::terse->new();
-}
-if ( $flags->{debug} == 2 ) {
-  require dep::handler::stdout;
-  $handler = dep::handler::stdout->new();
-}
+require Class::Load;
+Class::Load::load_class($hc);
+$handler = $hc->new();
 
-my $handler2 = dep::handler::bashcode->new( ( $flags->{debug} ? ( debug => 1 ) : () ), debug_handler => $handler, );
+my $handler2 = dep::handler::bashcode->new( debug => 1, debug_handler => $handler, );
 
 for my $qi (@squeue) {
   deptools::dispatch_dependency_handler( $release, @{$qi}, $handler2 );
@@ -136,7 +156,7 @@ if ( not defined $release_info->{abstract} ) {
 }
 else {
   my $abstract = $release_info->{abstract};
-  $abstract =~ s/'/'\\''/g;  #  ' => '\'' 
+  $abstract =~ s/'/'\\''/g;    #  ' => '\''
   $fh->say( 'DESCRIPTION=\'' . $abstract . '\'' );
 }
 

diff --git a/scripts/lib/dep/handler/stdout/simple.pm b/scripts/lib/dep/handler/stdout/simple.pm
new file mode 100644
index 0000000..ab55b86
--- /dev/null
+++ b/scripts/lib/dep/handler/stdout/simple.pm
@@ -0,0 +1,93 @@
+use strict;
+use warnings;
+
+package dep::handler::stdout::simple;
+
+# FILENAME: simple.pm
+# CREATED: 31/10/11 13:30:29 by Kent Fredric (kentnl) <kentfredric@×××××.com>
+# ABSTRACT: Dispatch terse dependency information to STDOUT.
+
+use Moose;
+#extends 'dep::handler::stdout::terse';
+has 'indent' => ( is => 'rw' );
+has 'tail'   => ( is => 'rw' );
+__PACKAGE__->meta->make_immutable;
+
+sub begin_dep {
+  my ( $self, $release, $module, $declaration ) = @_;
+  return *STDOUT->print("\n\n" . $self->_want_string( $release, $module, $declaration ) . "\n");
+}
+
+sub evt_not_any {
+  my ( $self, $module, $declaration ) = @_;
+  return *STDOUT->print("  No provider found for $module : @$declaration\n");
+}
+
+sub evt_multi {
+  my ( $self, $module, $declaration ) = @_;
+  return *STDOUT->print("  Multiple Providers found for " . $self->_want_string( "", $module, $declaration) . "\n");
+}
+
+sub set_latest {
+  my ( $self, $dep, $pkg ) = @_;
+  return *STDOUT->print("  Latest: @{$dep}  => ${pkg}\n");
+}
+
+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->print(" -> $module : @{$declaration} via $pkg\n");
+}
+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} );
+
+  *STDOUT->printf( "   %s -> %s (%s)\n", $depstring, $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->print( " closest: $v\n" );
+
+
+}
+
+sub done {
+  my ( $self, $module, $declaration ) = @_;
+  return *STDOUT->print( $self->tail );
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+1;
+