view release on metacpan or  search on metacpan

lib/B/DeparseTree/TreeMain.pm  view on Meta::CPAN

@ISA = qw(Exporter);
@EXPORT = qw(
    %globalnames
    %ignored_hints
    %rev_feature
    WARN_MASK
    coderef2info
    coderef2text
    const
    declare_hinthash
    declare_hints
    declare_warnings
    deparse_sub($$$$)
    deparse_subname($$)
    new
    next_todo
    pragmata
    seq_subs
    style_opts
    todo
    );

use Config;
my $is_cperl = $Config::Config{usecperl};

my $module;
if ($] >= 5.014 and $] < 5.016) {
    $module = "P514";
} elsif ($] >= 5.016 and $] < 5.018) {
    $module = "P516";
} elsif ($] >= 5.018 and $] < 5.020) {
    $module = "P518";
} elsif ($] >= 5.020 and $] < 5.022) {
    $module = "P520";
} elsif ($] >= 5.022 and $] < 5.024) {
    $module = "P522";
} elsif ($] >= 5.024 and $] < 5.026) {
    $module = "P524";
} elsif ($] >= 5.026) {
    $module = "P526";
} else {
    die "Can only handle Perl 5.16..5.26";
}

$module .= 'c' if $is_cperl;
@ISA = ("Exporter", "B::DeparseTree::$module");

require "B/DeparseTree/${module}.pm";

# The BEGIN {} is used here because otherwise this code isn't executed
# when you run B::Deparse on itself.
my %globalnames;
BEGIN { map($globalnames{$_}++, "SIG", "STDIN", "STDOUT", "STDERR", "INC",
	    "ENV", "ARGV", "ARGVOUT", "_"); }

my $max_prec;
BEGIN { $max_prec = int(0.999 + 8*length(pack("F", 42))*log(2)/log(10)); }

BEGIN {
    # List version-specific constants here.
    # Easiest way to keep this code portable between version looks to
    # be to fake up a dummy constant that will never actually be true.
    foreach (qw(OPpSORT_INPLACE OPpSORT_DESCEND OPpITER_REVERSED
                OPpCONST_NOVER OPpPAD_STATE PMf_SKIPWHITE RXf_SKIPWHITE
		RXf_PMf_CHARSET RXf_PMf_KEEPCOPY
		CVf_LOCKED OPpREVERSE_INPLACE OPpSUBSTR_REPL_FIRST
		PMf_NONDESTRUCT OPpCONST_ARYBASE OPpEVAL_BYTES)) {
	eval { import B $_ };
	no strict 'refs';
	*{$_} = sub () {0} unless *{$_}{CODE};
    }
}

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    $self->{'cuddle'} = " ";   #\n%| is another alternative
    $self->{'curcop'} = undef;
    $self->{'curstash'} = "main";
    $self->{'ex_const'} = "'?unrecoverable constant?'";
    $self->{'expand'} = 0;
    $self->{'files'} = {};

    # How many spaces per indent nesting?
    $self->{'indent_size'} = 4;

    $self->{'opaddr'} = 0;
    $self->{'linenums'} = 0;
    $self->{'parens'} = 0;
    $self->{'subs_todo'} = [];
    $self->{'unquote'} = 0;
    $self->{'use_dumper'} = 0;

    # Compress spaces with tabs? 1 tab = 8 spaces
    $self->{'use_tabs'} = 0;

    # Indentation level
    $self->{'level'} = 0;

    $self->{'ambient_arybase'} = 0;
    $self->{'ambient_warnings'} = undef; # Assume no lexical warnings
    $self->{'ambient_hints'} = 0;
    $self->{'ambient_hinthash'} = undef;

    # Given an opcode address, get the accumulated OP tree
    # OP for that. FIXME: remove this
    $self->{optree} = {};

    # For B::DeparseTree::TreeNode's that are created and don't have
    # real OPs associated with them, we assign a fake address;
    $self->{'last_fake_addr'} = 0;

    $self->init();

    while (my $arg = shift @_) {
	if ($arg eq "-d") {
	    $self->{'use_dumper'} = 1;
	    require Data::Dumper;
	} elsif ($arg =~ /^-f(.*)/) {
	    $self->{'files'}{$1} = 1;
	} elsif ($arg eq "-l") {