view release on metacpan or  search on metacpan

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

	# Leave {text} and {texts} uninitialized
    }

    foreach my $optname (qw(child_pos
			 maybe_parens
			 omit_next_semicolon
			 other_ops
			 parent_ops
			 position
			 prev_expr)) {
	$self->{$optname} = $opts->{$optname} if $opts->{$optname};
    }
    if (exists $self->{other_ops}) {
	my $ary = $self->{other_ops};
	unless (ref $ary eq 'ARRAY') {
	    Carp::confess("expecting other_ops to be a ref ARRAY; is $ary");
	}
	my $position = 0;
	for my $other_addr (@$ary) {
	    if ($other_addr == $addr) {
		Carp::confess("other_ops contains my address $addr at position $position");
	    }
	    $position++;
	}
    }
    if ($opts->{maybe_parens}) {
	my ($obj, $context, $precedence) = @{$opts->{maybe_parens}};
	my $parens = parens_test($obj, $context, $precedence);
	$self->{maybe_parens} = {
	    context => $context,
	    precedence => $precedence,
	    force => $obj->{'parens'},
	    parens => $parens ? 'true' : ''
	};
	$self->{text} = "($self->{text})" if exists $self->{text} and $parens;
    }
    return $self;
}

# Possibly add () around $text depending on precedence $prec and
# context $cx. We return a string.
sub maybe_parens($$$$)
{
    my($self, $info, $cx, $prec) = @_;
    if (parens_test($info, $cx, $prec)) {
	$info->{text} = $self->combine('', "(", $info->{text}, ")");
	# In a unop, let parent reuse our parens; see maybe_parens_unop
	if ($cx == 16) {
	    $info->{parens} = 'reuse';
	}  else {
	    $info->{parens} = 'true';
	}
	return $info->{text};
    } else {
	$info->{parens} = '';
	return $info->{text};
    }
}

# Update $self->{other_ops} to add $info
sub update_other_ops($$)
{
    my ($self, $info) = @_;
    $self->{other_ops} ||= [];
    my $other_ops = $self->{other_ops};
    push @{$other_ops}, $info;
    $self->{other_ops} = $other_ops;
}

# Demo code
unless(caller) {
    my $old_pkg = __PACKAGE__;
    package B::DeparseTree::TreeNodeDemo;
    sub new($) {
	my ($class) = @_;
	bless {}, $class;
    }
    sub combine2str($$$) {
	my ($self, $sep, $data) = @_;
	join($sep, @$data);
    }
    my $deparse = __PACKAGE__->new();
    my $node = $old_pkg->new('op', $deparse, ['X'], 'test', {});
    print $node->{text}, "\n";
}
1;