B-DeparseTree

 view release on metacpan or  search on metacpan

lib/B/DeparseTree/PP.pm

    pp_postdec
    pp_postinc
    pp_time
    pp_wait

    pp_print pp_prtf pp_say pp_sort
    pp_preinc pp_predec pp_i_preinc pp_i_predec

    pp_stub pp_exists
    );

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(OPpCONST_ARYBASE OPpEVAL_BYTES)) {
	eval { import B $_ };
	no strict 'refs';
	*{$_} = sub () {0} unless *{$_}{CODE};
    }
}

sub pp_egrent { baseop(@_, "endgrent") }
sub pp_ehostent { baseop(@_, "endhostent") }
sub pp_enetent { baseop(@_, "endnetent") }
sub pp_eprotoent { baseop(@_, "endprotoent") }
sub pp_epwent { baseop(@_, "endpwent") }
sub pp_eservent { baseop(@_, "endservent") }
sub pp_fork { baseop(@_, "fork") }
sub pp_getlogin { baseop(@_, "getlogin") }
sub pp_ggrent { baseop(@_, "getgrent") }
sub pp_ghostent { baseop(@_, "gethostent") }
sub pp_gnetent { baseop(@_, "getnetent") }
sub pp_gprotoent { baseop(@_, "getprotoent") }
sub pp_gpwent { baseop(@_, "getpwent") }
sub pp_grepstart { baseop(@_, "grep") }
sub pp_gservent { baseop(@_, "getservent") }
sub pp_mapstart { baseop(@_, "map") }
sub pp_sgrent { baseop(@_, "setgrent") }
sub pp_spwent { baseop(@_, "setpwent") }
sub pp_tms { baseop(@_, "times") }
sub pp_wantarray { baseop(@_, "wantarray") }

sub pp_leave { scopeop(1, @_); }
sub pp_lineseq { scopeop(0, @_); }
sub pp_scope { scopeop(0, @_); }

# Notice how subs and formats are inserted between statements here;
# also $[ assignments and pragmas.
sub pp_nextstate {
    my($self, $op, $cx) = @_;
    $self->{'curcop'} = $op;
    my @text = map($_->{text}, $self->cop_subs($op));
    my $stash = $op->stashpv;
    if ($stash ne $self->{'curstash'}) {
	push @text, "package $stash;\n";
	$self->{'curstash'} = $stash;
    }

    if (OPpCONST_ARYBASE && $self->{'arybase'} != $op->arybase) {
	push @text, '$[ = '. $op->arybase .";\n";
	$self->{'arybase'} = $op->arybase;
    }

    my $warnings = $op->warnings;
    my $warning_bits;
    if ($warnings->isa("B::SPECIAL") && $$warnings == 4) {
	$warning_bits = $warnings::Bits{"all"} & WARN_MASK;
    }
    elsif ($warnings->isa("B::SPECIAL") && $$warnings == 5) {
        $warning_bits = $warnings::NONE;
    }
    elsif ($warnings->isa("B::SPECIAL")) {
	$warning_bits = undef;
    }
    else {
	$warning_bits = $warnings->PV & WARN_MASK;
    }

    if (defined ($warning_bits) and
       !defined($self->{warnings}) || $self->{'warnings'} ne $warning_bits) {
	push @text, declare_warnings($self->{'warnings'}, $warning_bits);
	$self->{'warnings'} = $warning_bits;
    }

    my $hints = $op->hints;
    my $old_hints = $self->{'hints'};
    if ($self->{'hints'} != $hints) {
	push @text, declare_hints($self->{'hints'}, $hints);
	$self->{'hints'} = $hints;
    }

    my $newhh = $op->hints_hash->HASH;

    # feature bundle hints
    my $from = $old_hints & $feature::hint_mask;
    my $to   = $    hints & $feature::hint_mask;
    if ($from != $to) {
	if ($to == $feature::hint_mask) {
	    if ($self->{'hinthash'}) {
		delete $self->{'hinthash'}{$_}
		for grep /^feature_/, keys %{$self->{'hinthash'}};
	    }
	    else { $self->{'hinthash'} = {} }
	    $self->{'hinthash'}
	    = _features_from_bundle($from, $self->{'hinthash'});
	}
	else {
	    my $bundle =
		$feature::hint_bundles[$to >> $feature::hint_shift];
	    $bundle =~ s/(\d[13579])\z/$1+1/e; # 5.11 => 5.12
	    push @text, "no feature;\n",
		"use feature ':$bundle';\n";
	}
    }

    push @text, declare_hinthash(
	$self->{'hinthash'}, $newhh,
	$self->{indent_size}, $self->{hints},
	);
    $self->{'hinthash'} = $newhh;

 view all matches for this distribution
 view release on metacpan -  search on metacpan

( run in 0.466901 second using v1.00-cache-1.03-grep-7fa205e-cpan-6421e59f23b )