package B::RecDeparse;
+use 5.008;
+
use strict;
use warnings;
use Carp qw/croak/;
+use Config;
use base qw/B::Deparse/;
=head1 VERSION
-Version 0.01
+Version 0.03
=cut
-our $VERSION = '0.01';
+our $VERSION = '0.03';
=head1 SYNOPSIS
=head1 DESCRIPTION
-This module extends L<B::Deparse> by making you recursively replace subroutine calls encountered when deparsing.
+This module extends L<B::Deparse> by making it recursively replace subroutine calls encountered when deparsing.
Please refer to L<B::Deparse> documentation for what to do and how to do it. Besides the constructor syntax, everything should work the same for the two modules.
=cut
+use constant {
+ # p31268 made pp_entersub call single_delim
+ FOOL_SINGLE_DELIM =>
+ ($^V ge v5.9.5)
+ || ($^V lt v5.9.0 and $^V ge v5.8.9)
+ || ($Config{perl_patchlevel} && $Config{perl_patchlevel} >= 31268)
+};
+
sub _parse_args {
croak 'Optional arguments must be passed as key/value pairs' if @_ % 2;
my %args = @_;
}
sub _recurse {
- return $_[0]->{brd_level} >= 0 && $_[0]->{brd_cur} >= $_[0]->{brd_level}
+ return $_[0]->{brd_level} < 0 || $_[0]->{brd_cur} < $_[0]->{brd_level}
}
sub compile {
my $key = $; . __PACKAGE__ . $;;
-# p31268 made pp_entersub call single_delim
-if ($^V ge v5.9.5) {
+if (FOOL_SINGLE_DELIM) {
my $oldsd = *B::Deparse::single_delim{CODE};
no warnings 'redefine';
*B::Deparse::single_delim = sub {
my $body = $_[2];
- if ($body =~ s/^$key//) {
+ if ((caller 1)[0] eq __PACKAGE__ and $body =~ s/^$key//) {
return $body;
} else {
$oldsd->(@_);
sub pp_entersub {
my $self = shift;
- $self->{brd_sub} = 1;
- my $body = $self->SUPER::pp_entersub(@_);
- $self->{brd_sub} = 0;
- $body =~ s/^&\s*(\w)/$1/ if not $self->_recurse;
+ 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;
- $self->{brd_sub} = 0;
- my $body = $self->SUPER::pp_refgen(@_);
- $self->{brd_sub} = 1;
- return $body;
+ return do {
+ local $self->{brd_sub} = 0;
+ $self->SUPER::pp_refgen(@_);
+ }
}
sub pp_gv {
my $self = shift;
my $body;
- if ($self->{brd_sub} <= 0 || $self->_recurse) {
+ if ($self->{brd_sub} <= 0 || !$self->_recurse) {
$body = $self->SUPER::pp_gv(@_);
} else {
my $gv = $self->gv_or_padgv($_[0]);
- ++$self->{brd_cur};
- $body = 'sub ' . $self->indent($self->deparse_sub($gv->CV));
- --$self->{brd_cur};
- if ($^V lt v5.9.5) {
- $body .= '->';
- } else {
+ $body = do {
+ local @{$self}{qw/brd_sub brd_cur/} = (0, $self->{brd_cur} + 1);
+ 'sub ' . $self->indent($self->deparse_sub($gv->CV));
+ };
+ if (FOOL_SINGLE_DELIM) {
$body = $key . $body;
+ } else {
+ $body .= '->';
}
}
return $body;
=head2 C<pp_gv>
-Functions and methods from L<B::Deparse> overriden by this module. Never call them directly.
+Functions and methods from L<B::Deparse> reimplemented by this module. Never call them directly.
Otherwise, L<B::RecDeparse> inherits all methods from L<B::Deparse>.
=head1 DEPENDENCIES
-L<Carp> (standard since perl 5), L<B::Deparse> (since perl 5.005).
+L<Carp> (standard since perl 5), L<Config> (since perl 5.00307) and L<B::Deparse> (since perl 5.005).
=head1 AUTHOR
Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
-You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
+You can contact me by mail or on C<irc.perl.org> (vincent).
=head1 BUGS