File: Structure.pm

package info (click to toggle)
libppi-perl 0.903-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 840 kB
  • ctags: 429
  • sloc: perl: 5,551; makefile: 45
file content (146 lines) | stat: -rwxr-xr-x 3,570 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
package PPI::Structure;

# An abstract parent and a set of classes representing structures

use strict;
use UNIVERSAL 'isa';
use base 'PPI::Node';
use Scalar::Util 'refaddr';
use PPI::Structure::Block       ();
use PPI::Structure::Condition   ();
use PPI::Structure::Constructor ();
use PPI::Structure::ForLoop     ();
use PPI::Structure::List        ();
use PPI::Structure::Subscript   ();
use PPI::Structure::Unknown     ();

use vars qw{$VERSION *_PARENT};
BEGIN {
	$VERSION = '0.903';
	*_PARENT = *PPI::Element::_PARENT;
}





#####################################################################
# Constructor

sub new {
	my $class = shift;
	my $Token = (isa( ref $_[0], 'PPI::Token::Structure' ) && $_[0]->_opens)
		? shift : return undef;

	# Create the object
	my $self = bless {
		children => [],
		start    => $Token,
		}, $class;

	# Set the start braces parent link
	Scalar::Util::weaken(
		$_PARENT{refaddr $Token} = $self
		);

	$self;
}

# Hacky method to let the Lexer set the finish token, so it doesn't
# have to import %PPI::Element::_PARENT itself.
sub _set_finish {
	my $self  = shift;

	# Check the Token
	my $Token = isa(ref $_[0], 'PPI::Token::Structure') ? shift : return undef;
	$Token->parent and return undef; # Must be a detached token
	($self->start->_opposite eq $Token->content) or return undef; # ... that matches the opening token

	# Set the token
	$self->{finish} = $Token;
	$_PARENT{refaddr $Token} = $self;

	1;
}





#####################################################################
# PPI::Structure API methods

sub start  { $_[0]->{start}  }
sub finish { $_[0]->{finish} }

# What general brace type are we
sub braces {
	my $self = $_[0]->{start} ? shift : return undef;
	return { '[' => '[]', '(' => '()', '{' => '{}' }->{ $self->{start}->{content} };
}





#####################################################################
# PPI::Node overloaded methods

# For us, the "elements" concept includes the brace tokens
sub elements {
	my $self = shift;

	if ( wantarray ) {
		# Return a list in array context
		return ( $self->{start} || (), @{$self->{children}}, $self->{finish} || () );
	} else {
		# Return the number of elements in scalar context.
		# This is memory-cheaper than creating another big array
		return scalar(@{$self->{children}})
			+ ($self->{start} ? 1 : 0)
			+ ($self->{start} ? 1 : 0);
	}
}

# For us, the first element is probably the opening brace
sub first_element {
	# Technically, if we have no children and no opening brace,
	# then the first element is the closing brace.
	$_[0]->{start} or $_[0]->{children}->[0] or $_[0]->{finish};
}

# For us, the last element is probably the closing brace
sub last_element {
	# Technically, if we have no children and no closing brace,
	# then the last element is the opening brace
	$_[0]->{finish} or $_[0]->{children}->[-1] or $_[0]->{start};
}





#####################################################################
# PPI::Element overloaded methods

# Get the full set of tokens, including start and finish
sub tokens {
	my $self = shift;
	my @tokens = ( $self->{start} || (), $self->SUPER::tokens(@_), $self->{finish} || () );
	@tokens;
}

# Like the token method ->content, get our merged contents.
# This will recurse downwards through everything
### Reimplement this using List::Utils stuff
sub content {
	my $self = shift;
	my $content = $self->{start} ? $self->{start}->content : '';
	foreach my $child ( @{$self->{children}} ) {
		$content .= $child->content;
	}
	$content .= $self->{finish}->content if $self->{finish};
	$content;
}

1;