Bump copyright year

[perl/modules/B-RecDeparse.git] / lib / B / RecDeparse.pm

diff --git a/lib/B/RecDeparse.pm b/lib/B/RecDeparse.pm
index 15adc0772360445eca3ff56942e68b1c2cd8402e..a9ace562920d0a516f32958bcc93b4f41f35e9a6 100644 (file)
--- a/lib/B/RecDeparse.pm
+++ b/lib/B/RecDeparse.pm
@@ -5,9 +5,11 @@ use 5.008;
 use strict;
 use warnings;
 
+use B ();
+
 use Config;
 
-use base qw/B::Deparse/;
+use base qw<B::Deparse>;
 
 =head1 NAME
 
@@ -81,9 +83,13 @@ sub _parse_args {
 sub new {
  my $class = shift;
  $class = ref($class) || $class || __PACKAGE__;
+
  my ($deparse, $level) = _parse_args(@_);
+
  my $self = bless $class->SUPER::new(@$deparse), $class;
+
  $self->{brd_level} = $level;
+
  return $self;
 }
 
@@ -92,22 +98,28 @@ sub _recurse {
 }
 
 sub compile {
- my $bd = B::Deparse->new();
  my @args = @_;
+
+ my $bd = B::Deparse->new();
  my ($deparse, $level) = _parse_args(@args);
+
  my $compiler = $bd->coderef2text(B::Deparse::compile(@$deparse));
  $compiler =~ s/
   ['"]? B::Deparse ['"]? \s* -> \s* (new) \s* \( ([^\)]*) \)
  /B::RecDeparse->$1(deparse => [ $2 ], level => $level)/gx;
  $compiler = eval 'sub ' . $compiler;
  die if $@;
+
  return $compiler;
 }
 
 sub init {
  my $self = shift;
- $self->{brd_cur} = 0;
- $self->{brd_sub} = 0;
+
+ $self->{brd_cur}  = 0;
+ $self->{brd_sub}  = 0;
+ $self->{brd_seen} = { };
+
  $self->SUPER::init(@_);
 }
 
@@ -115,9 +127,11 @@ my $key = $; . __PACKAGE__ . $;;
 
 if (FOOL_SINGLE_DELIM) {
  my $oldsd = *B::Deparse::single_delim{CODE};
+
  no warnings 'redefine';
  *B::Deparse::single_delim = sub {
   my $body = $_[2];
+
   if ((caller 1)[0] eq __PACKAGE__ and $body =~ s/^$key//) {
    return $body;
   } else {
@@ -126,18 +140,35 @@ if (FOOL_SINGLE_DELIM) {
  }
 }
 
+sub deparse_sub {
+ my $self = shift;
+ my $cv   = $_[0];
+
+ my $name;
+ unless ($cv->CvFLAGS & B::CVf_ANON()) {
+  $name = $cv->GV->SAFENAME;
+ }
+
+ local $self->{brd_seen}->{$name} = 1 if defined $name;
+ return $self->SUPER::deparse_sub(@_);
+}
+
 sub pp_entersub {
  my $self = shift;
+
  my $body = do {
   local $self->{brd_sub} = 1;
   $self->SUPER::pp_entersub(@_);
  };
+
  $body =~ s/^&\s*(\w)/$1/ if $self->_recurse;
+
  return $body;
 }
 
 sub pp_refgen {
  my $self = shift;
+
  return do {
   local $self->{brd_sub} = 0;
   $self->SUPER::pp_refgen(@_);
@@ -146,21 +177,28 @@ sub pp_refgen {
 
 sub pp_gv {
  my $self = shift;
+
+ my $gv   = $self->gv_or_padgv($_[0]);
+ my $name = $gv->NAME;
+ my $seen = $self->{brd_seen};
+
  my $body;
- if ($self->{brd_sub} <= 0 || !$self->_recurse) {
+ if ($self->{brd_sub} <= 0 || !$self->_recurse || $seen->{$name}) {
   $body = $self->SUPER::pp_gv(@_);
  } else {
-  my $gv = $self->gv_or_padgv($_[0]);
   $body = do {
-   local @{$self}{qw/brd_sub brd_cur/} = (0, $self->{brd_cur} + 1);
+   local @{$self}{qw<brd_sub brd_cur>} = (0, $self->{brd_cur} + 1);
+   local $seen->{$name} = 1;
    'sub ' . $self->indent($self->deparse_sub($gv->CV));
   };
+
   if (FOOL_SINGLE_DELIM) {
    $body = $key . $body;
   } else {
    $body .= '->';
   }
  }
+
  return $body;
 }
 
@@ -168,6 +206,8 @@ sub pp_gv {
 
 =head2 C<init>
 
+=head2 C<deparse_sub>
+
 =head2 C<pp_entersub>
 
 =head2 C<pp_refgen>
@@ -206,7 +246,7 @@ Tests code coverage report is available at L<http://www.profvince.com/perl/cover
 
 =head1 COPYRIGHT & LICENSE
 
-Copyright 2008,2009,2010 Vincent Pit, all rights reserved.
+Copyright 2008,2009,2010,2011 Vincent Pit, all rights reserved.
 
 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.