From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from pigeon.gentoo.org ([208.92.234.80] helo=lists.gentoo.org) by finch.gentoo.org with esmtp (Exim 4.60) (envelope-from ) id 1RPmkq-0003y5-Mg for garchives@archives.gentoo.org; Mon, 14 Nov 2011 02:58:41 +0000 Received: from pigeon.gentoo.org (localhost [127.0.0.1]) by pigeon.gentoo.org (Postfix) with SMTP id CBE7621C08E; Mon, 14 Nov 2011 02:57:33 +0000 (UTC) Received: from smtp.gentoo.org (smtp.gentoo.org [140.211.166.183]) by pigeon.gentoo.org (Postfix) with ESMTP id 8F83521C08E for ; Mon, 14 Nov 2011 02:57:33 +0000 (UTC) Received: from pelican.gentoo.org (unknown [66.219.59.40]) (using TLSv1 with cipher AECDH-AES256-SHA (256/256 bits)) (No client certificate requested) by smtp.gentoo.org (Postfix) with ESMTPS id 0610E1B4033 for ; Mon, 14 Nov 2011 02:57:33 +0000 (UTC) Received: from localhost.localdomain (localhost [127.0.0.1]) by pelican.gentoo.org (Postfix) with ESMTP id 71FB780044 for ; Mon, 14 Nov 2011 02:57:32 +0000 (UTC) From: "Kent Fredric" To: gentoo-commits@lists.gentoo.org Content-type: text/plain; charset=UTF-8 Reply-To: gentoo-dev@lists.gentoo.org, "Kent Fredric" Message-ID: Subject: [gentoo-commits] proj/perl-overlay:master commit in: scripts/lib/dep/handler/ X-VCS-Repository: proj/perl-overlay X-VCS-Files: scripts/lib/dep/handler/bashcode.pm X-VCS-Directories: scripts/lib/dep/handler/ X-VCS-Committer: kent X-VCS-Committer-Name: Kent Fredric X-VCS-Revision: c5e19cb60b6e1676cb63edee02397b7b9dd01bcc Date: Mon, 14 Nov 2011 02:57:32 +0000 (UTC) Precedence: bulk List-Post: List-Help: List-Unsubscribe: List-Subscribe: List-Id: Gentoo Linux mail X-BeenThere: gentoo-commits@lists.gentoo.org Content-Transfer-Encoding: quoted-printable X-Archives-Salt: 592987bd-3e86-49f9-ad90-6a5c4cfe429e X-Archives-Hash: 99ca667b23fa305eaeef7b00327ba2e7 commit: c5e19cb60b6e1676cb63edee02397b7b9dd01bcc Author: Kent Fredric gmail com> AuthorDate: Mon Nov 14 02:50:16 2011 +0000 Commit: Kent Fredric gmail com> CommitDate: Mon Nov 14 02:50:16 2011 +0000 URL: http://git.overlays.gentoo.org/gitweb/?p=3Dproj/perl-overlay.= git;a=3Dcommit;h=3Dc5e19cb6 [scripts/lib] Add debug subdispatch to the bashcode emitter --- scripts/lib/dep/handler/bashcode.pm | 76 +++++++++++++++++++++++++----= ------ 1 files changed, 54 insertions(+), 22 deletions(-) diff --git a/scripts/lib/dep/handler/bashcode.pm b/scripts/lib/dep/handle= r/bashcode.pm index eb526e7..9187059 100644 --- a/scripts/lib/dep/handler/bashcode.pm +++ b/scripts/lib/dep/handler/bashcode.pm @@ -1,75 +1,108 @@ use strict; use warnings; + package dep::handler::bashcode; + # FILENAME: bashcode.pm # CREATED: 31/10/11 14:22:06 by Kent Fredric (kentnl) # ABSTRACT: Bash code dep handler =20 use Moose; +use MooseX::LazyRequire; + +has 'tdeps' =3D> ( is =3D> 'rw', isa =3D> 'ArrayRef', lazy =3D> 1, predi= cate =3D> 'has_tdeps', default =3D> sub { [] } ); +has 'rdeps' =3D> ( is =3D> 'rw', isa =3D> 'ArrayRef', lazy =3D> 1, predi= cate =3D> 'has_rdeps', default =3D> sub { [] } ); +has 'cdeps' =3D> ( is =3D> 'rw', isa =3D> 'ArrayRef', lazy =3D> 1, predi= cate =3D> 'has_cdeps', default =3D> sub { [] } ); +has 'bdeps' =3D> ( is =3D> 'rw', isa =3D> 'ArrayRef', lazy =3D> 1, predi= cate =3D> 'has_bdeps', default =3D> sub { [] } ); + +has 'debug' =3D> ( is =3D> 'rw', isa =3D> 'Bool', default =3D> sub { ret= urn } ); +has 'debug_handler' =3D> ( is =3D> 'rw', isa =3D> 'Object', lazy_require= d =3D> 1 ); =20 -has 'tdeps' =3D> (is =3D> 'rw',isa =3D> 'ArrayRef', lazy =3D> 1, predica= te =3D> 'has_tdeps' , default =3D> sub { [] } ); -has 'rdeps' =3D> (is =3D> 'rw', isa =3D> 'ArrayRef', lazy =3D> 1, predic= ate =3D> 'has_rdeps', default =3D> sub { [] } ); -has 'cdeps' =3D> (is =3D> 'rw', isa =3D> 'ArrayRef', lazy =3D> 1, predic= ate =3D> 'has_cdeps', default =3D> sub { [] } ); -has 'bdeps' =3D> (is =3D> 'rw', isa =3D> 'ArrayRef', lazy =3D> 1, predic= ate =3D> 'has_bdeps', default =3D> sub { [] } ); +has dep_current =3D> ( is =3D> 'rw', clearer =3D> 'clear_current' ); =20 -has dep_current =3D> ( is =3D> 'rw' , clearer =3D> 'clear_current' ); +sub do_debug { + my ( $self, $method, @args ) =3D @_; + return unless $self->debug; + my $handler =3D $self->debug_handler; + my $fun =3D $handler->can($method); + if ( not $fun ) { + warn "Can't dispatch debug method $fun\n"; + return; + } + return $fun->( $handler, @args ); +} =20 sub begin_dep { my ( $self, $release, $module, $declaration ) =3D @_; + $self->do_debug( 'begin_dep', $release, $module, $declaration ); $self->dep_current( { - for =3D> $module,=20 - wanted =3D> $declaration->[0], + for =3D> $module, + wanted =3D> $declaration->[0], for_phase =3D> $declaration->[2], - priority =3D> $declaration->[3], + priority =3D> $declaration->[3], } ); } =20 sub evt_not_any { my ( $self, $module, $declaration ) =3D @_; + $self->do_debug( 'evt_not_any', $module, $declaration ); + my $mesg =3D "No provider: $module "; $mesg .=3D $declaration->[0] if defined $declaration->[0]; - warn($mesg . "\n"); + warn( $mesg . "\n" ); } + sub evt_multi { my ( $self, $module, $declaration ) =3D @_; + $self->do_debug( 'evt_multi', $module, $declaration ); + my $mesg =3D "Mutli provider: $module "; $mesg .=3D $declaration->[0] if defined $declaration->[0]; - warn($mesg . "\n"); + warn( $mesg . "\n" ); } =20 sub set_latest { my ( $self, $dep, $pkg ) =3D @_; + $self->do_debug( 'set_latest', $dep, $pkg ); $self->dep_current->{choose} =3D $pkg; } =20 sub perl_dep { - my ( $self, $module, $declaration , $pkg ) =3D @_ ;=20 + my ( $self, $module, $declaration, $pkg ) =3D @_; + $self->do_debug( 'perl_dep', $module, $declaration, $pkg ); + $self->dep_current->{choose} =3D $pkg; } =20 -sub provider_group {=20 +sub provider_group { my ( $self, $data ) =3D @_; + $self->do_debug( 'provider_group', $data ); + } =20 -sub done {=20 +sub done { my ( $self, $module, $declaration ) =3D @_; + $self->do_debug( 'done', $module, $declaration ); + my $dc =3D $self->dep_current; + # *STDOUT->say( $dc->{for_phase} . ' ' . $dc->{priority} . ' ' . $dc= ->{for} . ' ' . $dc->{wanted} . ' ' . $dc->{choose} ); $self->clear_current; return if ( $dc->{for_phase} eq 'develop' or $dc->{priority} ne 'requi= res' ); - =20 - my $rec =3D { dep =3D> $dc->{for} , install =3D> $dc->{choose} }; - if( $dc->{wanted} ){=20 + + my $rec =3D { dep =3D> $dc->{for}, install =3D> $dc->{choose} }; + if ( $dc->{wanted} ) { require Gentoo::PerlMod::Version; - $rec->{dep} .=3D ' ' . $dc->{wanted} . ' ( ' . Gentoo::PerlMod::Vers= ion::gentooize_version( $dc->{wanted} , { lax =3D> 1 }) . ' )'; + $rec->{dep} .=3D + ' ' . $dc->{wanted} . ' ( ' . Gentoo::PerlMod::Version::gentooize_= version( $dc->{wanted}, { lax =3D> 1 } ) . ' )'; } =20 - push @{ $self->bdeps }, $rec if $dc->{for_phase} eq 'build'; - push @{ $self->cdeps }, $rec if $dc->{for_phase} eq 'configure'; - push @{ $self->tdeps }, $rec if $dc->{for_phase} eq 'test'; - push @{ $self->rdeps }, $rec if $dc->{for_phase} eq 'runtime'; + push @{ $self->bdeps }, $rec if $dc->{for_phase} eq 'build'; + push @{ $self->cdeps }, $rec if $dc->{for_phase} eq 'configure'; + push @{ $self->tdeps }, $rec if $dc->{for_phase} eq 'test'; + push @{ $self->rdeps }, $rec if $dc->{for_phase} eq 'runtime'; return; } =20 @@ -77,4 +110,3 @@ no Moose; __PACKAGE__->meta->make_immutable; 1; =20 -