Commit | Line | Data |
3fea05b9 |
1 | package PPI::Element; |
2 | |
3 | =pod |
4 | |
5 | =head1 NAME |
6 | |
7 | PPI::Element - The abstract Element class, a base for all source objects |
8 | |
9 | =head1 INHERITANCE |
10 | |
11 | PPI::Element is the root of the PDOM tree |
12 | |
13 | =head1 DESCRIPTION |
14 | |
15 | The abstract C<PPI::Element> serves as a base class for all source-related |
16 | objects, from a single whitespace token to an entire document. It provides |
17 | a basic set of methods to provide a common interface and basic |
18 | implementations. |
19 | |
20 | =head1 METHODS |
21 | |
22 | =cut |
23 | |
24 | use strict; |
25 | use Clone (); |
26 | use Scalar::Util qw{refaddr}; |
27 | use Params::Util qw{_INSTANCE _ARRAY}; |
28 | use List::MoreUtils (); |
29 | use PPI::Util (); |
30 | use PPI::Node (); |
31 | |
32 | use vars qw{$VERSION $errstr %_PARENT}; |
33 | BEGIN { |
34 | $VERSION = '1.206'; |
35 | $errstr = ''; |
36 | |
37 | # Master Child -> Parent index |
38 | %_PARENT = (); |
39 | } |
40 | |
41 | use overload 'bool' => \&PPI::Util::TRUE; |
42 | use overload '""' => 'content'; |
43 | use overload '==' => '__equals'; |
44 | use overload '!=' => '__nequals'; |
45 | use overload 'eq' => '__eq'; |
46 | use overload 'ne' => '__ne'; |
47 | |
48 | |
49 | |
50 | |
51 | |
52 | ##################################################################### |
53 | # General Properties |
54 | |
55 | =pod |
56 | |
57 | =head2 significant |
58 | |
59 | Because we treat whitespace and other non-code items as Tokens (in order to |
60 | be able to "round trip" the L<PPI::Document> back to a file) the |
61 | C<significant> method allows us to distinguish between tokens that form a |
62 | part of the code, and tokens that aren't significant, such as whitespace, |
63 | POD, or the portion of a file after (and including) the C<__END__> token. |
64 | |
65 | Returns true if the Element is significant, or false it not. |
66 | |
67 | =cut |
68 | |
69 | ### XS -> PPI/XS.xs:_PPI_Element__significant 0.845+ |
70 | sub significant { 1 } |
71 | |
72 | =pod |
73 | |
74 | =head2 class |
75 | |
76 | The C<class> method is provided as a convenience, and really does nothing |
77 | more than returning C<ref($self)>. However, some people have found that |
78 | they appreciate the laziness of C<$Foo-E<gt>class eq 'whatever'>, so I |
79 | have caved to popular demand and included it. |
80 | |
81 | Returns the class of the Element as a string |
82 | |
83 | =cut |
84 | |
85 | sub class { ref($_[0]) } |
86 | |
87 | =pod |
88 | |
89 | =head2 tokens |
90 | |
91 | The C<tokens> method returns a list of L<PPI::Token> objects for the |
92 | Element, essentially getting back that part of the document as if it had |
93 | not been lexed. |
94 | |
95 | This also means there are no Statements and no Structures in the list, |
96 | just the Token classes. |
97 | |
98 | =cut |
99 | |
100 | sub tokens { $_[0] } |
101 | |
102 | =pod |
103 | |
104 | =head2 content |
105 | |
106 | For B<any> C<PPI::Element>, the C<content> method will reconstitute the |
107 | base code for it as a single string. This method is also the method used |
108 | for overloading stringification. When an Element is used in a double-quoted |
109 | string for example, this is the method that is called. |
110 | |
111 | B<WARNING:> |
112 | |
113 | You should be aware that because of the way that here-docs are handled, any |
114 | here-doc content is not included in C<content>, and as such you should |
115 | B<not> eval or execute the result if it contains any L<PPI::Token::HereDoc>. |
116 | |
117 | The L<PPI::Document> method C<serialize> should be used to stringify a PDOM |
118 | document into something that can be executed as expected. |
119 | |
120 | Returns the basic code as a string (excluding here-doc content). |
121 | |
122 | =cut |
123 | |
124 | ### XS -> PPI/XS.xs:_PPI_Element__content 0.900+ |
125 | sub content { '' } |
126 | |
127 | |
128 | |
129 | |
130 | |
131 | ##################################################################### |
132 | # Naigation Methods |
133 | |
134 | =pod |
135 | |
136 | =head2 parent |
137 | |
138 | Elements themselves are not intended to contain other Elements, that is |
139 | left to the L<PPI::Node> abstract class, a subclass of C<PPI::Element>. |
140 | However, all Elements can be contained B<within> a parent Node. |
141 | |
142 | If an Element is within a parent Node, the C<parent> method returns the |
143 | Node. |
144 | |
145 | =cut |
146 | |
147 | sub parent { $_PARENT{refaddr $_[0]} } |
148 | |
149 | =pod |
150 | |
151 | =head2 descendant_of $element |
152 | |
153 | Answers whether a C<PPI::Element> is contained within another one. |
154 | |
155 | C<PPI::Element>s are considered to be descendants of themselves. |
156 | |
157 | =begin testing descendant_of 9 |
158 | |
159 | my $Document = PPI::Document->new( \'( [ thingy ] ); $blarg = 1' ); |
160 | isa_ok( $Document, 'PPI::Document' ); |
161 | ok( |
162 | $Document->descendant_of($Document), |
163 | 'Document is a descendant of itself.', |
164 | ); |
165 | |
166 | my $words = $Document->find('Token::Word'); |
167 | is(scalar @{$words}, 1, 'Document contains 1 Word.'); |
168 | my $word = $words->[0]; |
169 | ok( |
170 | $word->descendant_of($word), |
171 | 'Word is a descendant of itself.', |
172 | ); |
173 | ok( |
174 | $word->descendant_of($Document), |
175 | 'Word is a descendant of the Document.', |
176 | ); |
177 | ok( |
178 | ! $Document->descendant_of($word), |
179 | 'Document is not a descendant of the Word.', |
180 | ); |
181 | |
182 | my $symbols = $Document->find('Token::Symbol'); |
183 | is(scalar @{$symbols}, 1, 'Document contains 1 Symbol.'); |
184 | my $symbol = $symbols->[0]; |
185 | ok( |
186 | ! $word->descendant_of($symbol), |
187 | 'Word is not a descendant the Symbol.', |
188 | ); |
189 | ok( |
190 | ! $symbol->descendant_of($word), |
191 | 'Symbol is not a descendant the Word.', |
192 | ); |
193 | |
194 | =end testing |
195 | |
196 | =cut |
197 | |
198 | sub descendant_of { |
199 | my $cursor = shift; |
200 | my $parent = shift or return undef; |
201 | while ( refaddr $cursor != refaddr $parent ) { |
202 | $cursor = $_PARENT{refaddr $cursor} or return ''; |
203 | } |
204 | return 1; |
205 | } |
206 | |
207 | =pod |
208 | |
209 | =head2 ancestor_of $element |
210 | |
211 | Answers whether a C<PPI::Element> is contains another one. |
212 | |
213 | C<PPI::Element>s are considered to be ancestors of themselves. |
214 | |
215 | =begin testing ancestor_of 9 |
216 | |
217 | my $Document = PPI::Document->new( \'( [ thingy ] ); $blarg = 1' ); |
218 | isa_ok( $Document, 'PPI::Document' ); |
219 | ok( |
220 | $Document->ancestor_of($Document), |
221 | 'Document is an ancestor of itself.', |
222 | ); |
223 | |
224 | my $words = $Document->find('Token::Word'); |
225 | is(scalar @{$words}, 1, 'Document contains 1 Word.'); |
226 | my $word = $words->[0]; |
227 | ok( |
228 | $word->ancestor_of($word), |
229 | 'Word is an ancestor of itself.', |
230 | ); |
231 | ok( |
232 | ! $word->ancestor_of($Document), |
233 | 'Word is not an ancestor of the Document.', |
234 | ); |
235 | ok( |
236 | $Document->ancestor_of($word), |
237 | 'Document is an ancestor of the Word.', |
238 | ); |
239 | |
240 | my $symbols = $Document->find('Token::Symbol'); |
241 | is(scalar @{$symbols}, 1, 'Document contains 1 Symbol.'); |
242 | my $symbol = $symbols->[0]; |
243 | ok( |
244 | ! $word->ancestor_of($symbol), |
245 | 'Word is not an ancestor the Symbol.', |
246 | ); |
247 | ok( |
248 | ! $symbol->ancestor_of($word), |
249 | 'Symbol is not an ancestor the Word.', |
250 | ); |
251 | |
252 | =end testing |
253 | |
254 | =cut |
255 | |
256 | sub ancestor_of { |
257 | my $self = shift; |
258 | my $cursor = shift or return undef; |
259 | while ( refaddr $cursor != refaddr $self ) { |
260 | $cursor = $_PARENT{refaddr $cursor} or return ''; |
261 | } |
262 | return 1; |
263 | } |
264 | |
265 | =pod |
266 | |
267 | =head2 statement |
268 | |
269 | For a C<PPI::Element> that is contained (at some depth) within a |
270 | L<PPI::Statment>, the C<statement> method will return the first parent |
271 | Statement object lexically 'above' the Element. |
272 | |
273 | Returns a L<PPI::Statement> object, which may be the same Element if the |
274 | Element is itself a L<PPI::Statement> object. |
275 | |
276 | Returns false if the Element is not within a Statement and is not itself |
277 | a Statement. |
278 | |
279 | =cut |
280 | |
281 | sub statement { |
282 | my $cursor = shift; |
283 | while ( ! _INSTANCE($cursor, 'PPI::Statement') ) { |
284 | $cursor = $_PARENT{refaddr $cursor} or return ''; |
285 | } |
286 | $cursor; |
287 | } |
288 | |
289 | =pod |
290 | |
291 | =head2 top |
292 | |
293 | For a C<PPI::Element> that is contained within a PDOM tree, the C<top> method |
294 | will return the top-level Node in the tree. Most of the time this should be |
295 | a L<PPI::Document> object, however this will not always be so. For example, |
296 | if a subroutine has been removed from its Document, to be moved to another |
297 | Document. |
298 | |
299 | Returns the top-most PDOM object, which may be the same Element, if it is |
300 | not within any parent PDOM object. |
301 | |
302 | =cut |
303 | |
304 | sub top { |
305 | my $cursor = shift; |
306 | while ( my $parent = $_PARENT{refaddr $cursor} ) { |
307 | $cursor = $parent; |
308 | } |
309 | $cursor; |
310 | } |
311 | |
312 | =pod |
313 | |
314 | For an Element that is contained within a L<PPI::Document> object, |
315 | the C<document> method will return the top-level Document for the Element. |
316 | |
317 | Returns the L<PPI::Document> for this Element, or false if the Element is not |
318 | contained within a Document. |
319 | |
320 | =cut |
321 | |
322 | sub document { |
323 | my $top = shift->top; |
324 | _INSTANCE($top, 'PPI::Document') and $top; |
325 | } |
326 | |
327 | =pod |
328 | |
329 | =head2 next_sibling |
330 | |
331 | All L<PPI::Node> objects (specifically, our parent Node) contain a number of |
332 | C<PPI::Element> objects. The C<next_sibling> method returns the C<PPI::Element> |
333 | immediately after the current one, or false if there is no next sibling. |
334 | |
335 | =cut |
336 | |
337 | sub next_sibling { |
338 | my $self = shift; |
339 | my $parent = $_PARENT{refaddr $self} or return ''; |
340 | my $key = refaddr $self; |
341 | my $elements = $parent->{children}; |
342 | my $position = List::MoreUtils::firstidx { |
343 | refaddr $_ == $key |
344 | } @$elements; |
345 | $elements->[$position + 1] || ''; |
346 | } |
347 | |
348 | =pod |
349 | |
350 | =head2 snext_sibling |
351 | |
352 | As per the other 's' methods, the C<snext_sibling> method returns the next |
353 | B<significant> sibling of the C<PPI::Element> object. |
354 | |
355 | Returns a C<PPI::Element> object, or false if there is no 'next' significant |
356 | sibling. |
357 | |
358 | =cut |
359 | |
360 | sub snext_sibling { |
361 | my $self = shift; |
362 | my $parent = $_PARENT{refaddr $self} or return ''; |
363 | my $key = refaddr $self; |
364 | my $elements = $parent->{children}; |
365 | my $position = List::MoreUtils::firstidx { |
366 | refaddr $_ == $key |
367 | } @$elements; |
368 | while ( defined(my $it = $elements->[++$position]) ) { |
369 | return $it if $it->significant; |
370 | } |
371 | ''; |
372 | } |
373 | |
374 | =pod |
375 | |
376 | =head2 previous_sibling |
377 | |
378 | All L<PPI::Node> objects (specifically, our parent Node) contain a number of |
379 | C<PPI::Element> objects. The C<previous_sibling> method returns the Element |
380 | immediately before the current one, or false if there is no 'previous' |
381 | C<PPI::Element> object. |
382 | |
383 | =cut |
384 | |
385 | sub previous_sibling { |
386 | my $self = shift; |
387 | my $parent = $_PARENT{refaddr $self} or return ''; |
388 | my $key = refaddr $self; |
389 | my $elements = $parent->{children}; |
390 | my $position = List::MoreUtils::firstidx { |
391 | refaddr $_ == $key |
392 | } @$elements; |
393 | $position and $elements->[$position - 1] or ''; |
394 | } |
395 | |
396 | =pod |
397 | |
398 | =head2 sprevious_sibling |
399 | |
400 | As per the other 's' methods, the C<sprevious_sibling> method returns |
401 | the previous B<significant> sibling of the C<PPI::Element> object. |
402 | |
403 | Returns a C<PPI::Element> object, or false if there is no 'previous' significant |
404 | sibling. |
405 | |
406 | =cut |
407 | |
408 | sub sprevious_sibling { |
409 | my $self = shift; |
410 | my $parent = $_PARENT{refaddr $self} or return ''; |
411 | my $key = refaddr $self; |
412 | my $elements = $parent->{children}; |
413 | my $position = List::MoreUtils::firstidx { |
414 | refaddr $_ == $key |
415 | } @$elements; |
416 | while ( $position-- and defined(my $it = $elements->[$position]) ) { |
417 | return $it if $it->significant; |
418 | } |
419 | ''; |
420 | } |
421 | |
422 | =pod |
423 | |
424 | =head2 first_token |
425 | |
426 | As a support method for higher-order algorithms that deal specifically with |
427 | tokens and actual Perl content, the C<first_token> method finds the first |
428 | PPI::Token object within or equal to this one. |
429 | |
430 | That is, if called on a L<PPI::Node> subclass, it will descend until it |
431 | finds a L<PPI::Token>. If called on a L<PPI::Token> object, it will return |
432 | the same object. |
433 | |
434 | Returns a L<PPI::Token> object, or dies on error (which should be extremely |
435 | rare and only occur if an illegal empty L<PPI::Statement> exists below the |
436 | current Element somewhere. |
437 | |
438 | =cut |
439 | |
440 | sub first_token { |
441 | my $cursor = shift; |
442 | while ( $cursor->isa('PPI::Node') ) { |
443 | $cursor = $cursor->first_element |
444 | or die "Found empty PPI::Node while getting first token"; |
445 | } |
446 | $cursor; |
447 | } |
448 | |
449 | |
450 | =pod |
451 | |
452 | =head2 last_token |
453 | |
454 | As a support method for higher-order algorithms that deal specifically with |
455 | tokens and actual Perl content, the C<last_token> method finds the last |
456 | PPI::Token object within or equal to this one. |
457 | |
458 | That is, if called on a L<PPI::Node> subclass, it will descend until it |
459 | finds a L<PPI::Token>. If called on a L<PPI::Token> object, it will return |
460 | the itself. |
461 | |
462 | Returns a L<PPI::Token> object, or dies on error (which should be extremely |
463 | rare and only occur if an illegal empty L<PPI::Statement> exists below the |
464 | current Element somewhere. |
465 | |
466 | =cut |
467 | |
468 | sub last_token { |
469 | my $cursor = shift; |
470 | while ( $cursor->isa('PPI::Node') ) { |
471 | $cursor = $cursor->last_element |
472 | or die "Found empty PPI::Node while getting first token"; |
473 | } |
474 | $cursor; |
475 | } |
476 | |
477 | =pod |
478 | |
479 | =head2 next_token |
480 | |
481 | As a support method for higher-order algorithms that deal specifically with |
482 | tokens and actual Perl content, the C<next_token> method finds the |
483 | L<PPI::Token> object that is immediately after the current Element, even if |
484 | it is not within the same parent L<PPI::Node> as the one for which the |
485 | method is being called. |
486 | |
487 | Note that this is B<not> defined as a L<PPI::Token>-specific method, |
488 | because it can be useful to find the next token that is after, say, a |
489 | L<PPI::Statement>, although obviously it would be useless to want the |
490 | next token after a L<PPI::Document>. |
491 | |
492 | Returns a L<PPI::Token> object, or false if there are no more tokens after |
493 | the Element. |
494 | |
495 | =cut |
496 | |
497 | sub next_token { |
498 | my $cursor = shift; |
499 | |
500 | # Find the next element, going upwards as needed |
501 | while ( 1 ) { |
502 | my $element = $cursor->next_sibling; |
503 | if ( $element ) { |
504 | return $element if $element->isa('PPI::Token'); |
505 | return $element->first_token; |
506 | } |
507 | $cursor = $cursor->parent or return ''; |
508 | if ( $cursor->isa('PPI::Structure') and $cursor->finish ) { |
509 | return $cursor->finish; |
510 | } |
511 | } |
512 | } |
513 | |
514 | =pod |
515 | |
516 | =head2 previous_token |
517 | |
518 | As a support method for higher-order algorithms that deal specifically with |
519 | tokens and actual Perl content, the C<previous_token> method finds the |
520 | L<PPI::Token> object that is immediately before the current Element, even |
521 | if it is not within the same parent L<PPI::Node> as this one. |
522 | |
523 | Note that this is not defined as a L<PPI::Token>-only method, because it can |
524 | be useful to find the token is before, say, a L<PPI::Statement>, although |
525 | obviously it would be useless to want the next token before a |
526 | L<PPI::Document>. |
527 | |
528 | Returns a L<PPI::Token> object, or false if there are no more tokens before |
529 | the C<Element>. |
530 | |
531 | =cut |
532 | |
533 | sub previous_token { |
534 | my $cursor = shift; |
535 | |
536 | # Find the previous element, going upwards as needed |
537 | while ( 1 ) { |
538 | my $element = $cursor->previous_sibling; |
539 | if ( $element ) { |
540 | return $element if $element->isa('PPI::Token'); |
541 | return $element->last_token; |
542 | } |
543 | $cursor = $cursor->parent or return ''; |
544 | if ( $cursor->isa('PPI::Structure') and $cursor->start ) { |
545 | return $cursor->start; |
546 | } |
547 | } |
548 | } |
549 | |
550 | |
551 | |
552 | |
553 | |
554 | ##################################################################### |
555 | # Manipulation |
556 | |
557 | =pod |
558 | |
559 | =head2 clone |
560 | |
561 | As per the L<Clone> module, the C<clone> method makes a perfect copy of |
562 | an Element object. In the generic case, the implementation is done using |
563 | the L<Clone> module's mechanism itself. In higher-order cases, such as for |
564 | Nodes, there is more work involved to keep the parent-child links intact. |
565 | |
566 | =cut |
567 | |
568 | sub clone { |
569 | Clone::clone(shift); |
570 | } |
571 | |
572 | =pod |
573 | |
574 | =head2 insert_before @Elements |
575 | |
576 | The C<insert_before> method allows you to insert lexical perl content, in |
577 | the form of C<PPI::Element> objects, before the calling C<Element>. You |
578 | need to be very careful when modifying perl code, as it's easy to break |
579 | things. |
580 | |
581 | In its initial incarnation, this method allows you to insert a single |
582 | Element, and will perform some basic checking to prevent you inserting |
583 | something that would be structurally wrong (in PDOM terms). |
584 | |
585 | In future, this method may be enhanced to allow the insertion of multiple |
586 | Elements, inline-parsed code strings or L<PPI::Document::Fragment> objects. |
587 | |
588 | Returns true if the Element was inserted, false if it can not be inserted, |
589 | or C<undef> if you do not provide a L<PPI::Element> object as a parameter. |
590 | |
591 | =begin testing __insert_before 6 |
592 | |
593 | my $Document = PPI::Document->new( \"print 'Hello World';" ); |
594 | isa_ok( $Document, 'PPI::Document' ); |
595 | my $semi = $Document->find_first('Token::Structure'); |
596 | isa_ok( $semi, 'PPI::Token::Structure' ); |
597 | is( $semi->content, ';', 'Got expected token' ); |
598 | my $foo = PPI::Token::Word->new('foo'); |
599 | isa_ok( $foo, 'PPI::Token::Word' ); |
600 | is( $foo->content, 'foo', 'Created Word token' ); |
601 | $semi->__insert_before( $foo ); |
602 | is( $Document->serialize, "print 'Hello World'foo;", |
603 | '__insert_before actually inserts' ); |
604 | |
605 | =end testing |
606 | |
607 | =begin testing insert_before after __insert_before 6 |
608 | |
609 | my $Document = PPI::Document->new( \"print 'Hello World';" ); |
610 | isa_ok( $Document, 'PPI::Document' ); |
611 | my $semi = $Document->find_first('Token::Structure'); |
612 | isa_ok( $semi, 'PPI::Token::Structure' ); |
613 | is( $semi->content, ';', 'Got expected token' ); |
614 | my $foo = PPI::Token::Word->new('foo'); |
615 | isa_ok( $foo, 'PPI::Token::Word' ); |
616 | is( $foo->content, 'foo', 'Created Word token' ); |
617 | $semi->insert_before( $foo ); |
618 | is( $Document->serialize, "print 'Hello World'foo;", |
619 | 'insert_before actually inserts' ); |
620 | |
621 | =end testing |
622 | |
623 | =cut |
624 | |
625 | sub __insert_before { |
626 | my $self = shift; |
627 | $self->parent->__insert_before_child( $self, @_ ); |
628 | } |
629 | |
630 | =pod |
631 | |
632 | =head2 insert_after @Elements |
633 | |
634 | The C<insert_after> method allows you to insert lexical perl content, in |
635 | the form of C<PPI::Element> objects, after the calling C<Element>. You need |
636 | to be very careful when modifying perl code, as it's easy to break things. |
637 | |
638 | In its initial incarnation, this method allows you to insert a single |
639 | Element, and will perform some basic checking to prevent you inserting |
640 | something that would be structurally wrong (in PDOM terms). |
641 | |
642 | In future, this method may be enhanced to allow the insertion of multiple |
643 | Elements, inline-parsed code strings or L<PPI::Document::Fragment> objects. |
644 | |
645 | Returns true if the Element was inserted, false if it can not be inserted, |
646 | or C<undef> if you do not provide a L<PPI::Element> object as a parameter. |
647 | |
648 | =begin testing __insert_after 6 |
649 | |
650 | my $Document = PPI::Document->new( \"print 'Hello World';" ); |
651 | isa_ok( $Document, 'PPI::Document' ); |
652 | my $string = $Document->find_first('Token::Quote'); |
653 | isa_ok( $string, 'PPI::Token::Quote' ); |
654 | is( $string->content, "'Hello World'", 'Got expected token' ); |
655 | my $foo = PPI::Token::Word->new('foo'); |
656 | isa_ok( $foo, 'PPI::Token::Word' ); |
657 | is( $foo->content, 'foo', 'Created Word token' ); |
658 | $string->__insert_after( $foo ); |
659 | is( $Document->serialize, "print 'Hello World'foo;", |
660 | '__insert_after actually inserts' ); |
661 | |
662 | =end testing |
663 | |
664 | =begin testing insert_after after __insert_after 6 |
665 | |
666 | my $Document = PPI::Document->new( \"print 'Hello World';" ); |
667 | isa_ok( $Document, 'PPI::Document' ); |
668 | my $string = $Document->find_first('Token::Quote'); |
669 | isa_ok( $string, 'PPI::Token::Quote' ); |
670 | is( $string->content, "'Hello World'", 'Got expected token' ); |
671 | my $foo = PPI::Token::Word->new('foo'); |
672 | isa_ok( $foo, 'PPI::Token::Word' ); |
673 | is( $foo->content, 'foo', 'Created Word token' ); |
674 | $string->insert_after( $foo ); |
675 | is( $Document->serialize, "print 'Hello World'foo;", |
676 | 'insert_after actually inserts' ); |
677 | |
678 | =end testing |
679 | |
680 | =cut |
681 | |
682 | sub __insert_after { |
683 | my $self = shift; |
684 | $self->parent->__insert_after_child( $self, @_ ); |
685 | } |
686 | |
687 | =pod |
688 | |
689 | =head2 remove |
690 | |
691 | For a given C<PPI::Element>, the C<remove> method will remove it from its |
692 | parent B<intact>, along with all of its children. |
693 | |
694 | Returns the C<Element> itself as a convenience, or C<undef> if an error |
695 | occurs while trying to remove the C<Element>. |
696 | |
697 | =cut |
698 | |
699 | sub remove { |
700 | my $self = shift; |
701 | my $parent = $self->parent or return $self; |
702 | $parent->remove_child( $self ); |
703 | } |
704 | |
705 | =pod |
706 | |
707 | =head2 delete |
708 | |
709 | For a given C<PPI::Element>, the C<remove> method will remove it from its |
710 | parent, immediately deleting the C<Element> and all of its children (if it |
711 | has any). |
712 | |
713 | Returns true if the C<Element> was successfully deleted, or C<undef> if |
714 | an error occurs while trying to remove the C<Element>. |
715 | |
716 | =cut |
717 | |
718 | sub delete { |
719 | $_[0]->remove or return undef; |
720 | $_[0]->DESTROY; |
721 | 1; |
722 | } |
723 | |
724 | =pod |
725 | |
726 | =head2 replace $Element |
727 | |
728 | Although some higher level class support more exotic forms of replace, |
729 | at the basic level the C<replace> method takes a single C<Element> as |
730 | an argument and replaces the current C<Element> with it. |
731 | |
732 | To prevent accidental damage to code, in this initial implementation the |
733 | replacement element B<must> be of the same class (or a subclass) as the |
734 | one being replaced. |
735 | |
736 | =cut |
737 | |
738 | sub replace { |
739 | my $self = ref $_[0] ? shift : return undef; |
740 | my $Element = _INSTANCE(shift, ref $self) or return undef; |
741 | die "The ->replace method has not yet been implemented"; |
742 | } |
743 | |
744 | =pod |
745 | |
746 | =head2 location |
747 | |
748 | If the Element exists within a L<PPI::Document> that has |
749 | indexed the Element locations using C<PPI::Document::index_locations>, the |
750 | C<location> method will return the location of the first character of the |
751 | Element within the Document. |
752 | |
753 | Returns the location as a reference to a five-element array in the form C<[ |
754 | $line, $rowchar, $col, $logical_line, $logical_file_name ]>. The values are in |
755 | a human format, with the first character of the file located at C<[ 1, 1, 1, ?, |
756 | 'something' ]>. |
757 | |
758 | The second and third numbers are similar, except that the second is the |
759 | literal horizontal character, and the third is the visual column, taking |
760 | into account tabbing (see L<PPI::Document/"tab_width [ $width ]">). |
761 | |
762 | The fourth number is the line number, taking into account any C<#line> |
763 | directives. The fifth element is the name of the file that the element was |
764 | found in, if available, taking into account any C<#line> directives. |
765 | |
766 | Returns C<undef> on error, or if the L<PPI::Document> object has not been |
767 | indexed. |
768 | |
769 | =cut |
770 | |
771 | sub location { |
772 | my $self = shift; |
773 | |
774 | $self->_ensure_location_present or return undef; |
775 | |
776 | # Return a copy, not the original |
777 | return [ @{$self->{_location}} ]; |
778 | } |
779 | |
780 | =pod |
781 | |
782 | =head2 line_number |
783 | |
784 | If the Element exists within a L<PPI::Document> that has indexed the Element |
785 | locations using C<PPI::Document::index_locations>, the C<line_number> method |
786 | will return the line number of the first character of the Element within the |
787 | Document. |
788 | |
789 | Returns C<undef> on error, or if the L<PPI::Document> object has not been |
790 | indexed. |
791 | |
792 | =begin testing line_number 3 |
793 | |
794 | my $document = PPI::Document->new(\<<'END_PERL'); |
795 | |
796 | |
797 | foo |
798 | END_PERL |
799 | |
800 | isa_ok( $document, 'PPI::Document' ); |
801 | my $words = $document->find('PPI::Token::Word'); |
802 | is( scalar @{$words}, 1, 'Found expected word token.' ); |
803 | is( $words->[0]->line_number, 3, 'Got correct line number.' ); |
804 | |
805 | =end testing |
806 | |
807 | =cut |
808 | |
809 | sub line_number { |
810 | my $self = shift; |
811 | |
812 | my $location = $self->location() or return undef; |
813 | return $location->[0]; |
814 | } |
815 | |
816 | =pod |
817 | |
818 | =head2 column_number |
819 | |
820 | If the Element exists within a L<PPI::Document> that has indexed the Element |
821 | locations using C<PPI::Document::index_locations>, the C<column_number> method |
822 | will return the column number of the first character of the Element within the |
823 | Document. |
824 | |
825 | Returns C<undef> on error, or if the L<PPI::Document> object has not been |
826 | indexed. |
827 | |
828 | =begin testing column_number 3 |
829 | |
830 | my $document = PPI::Document->new(\<<'END_PERL'); |
831 | |
832 | |
833 | foo |
834 | END_PERL |
835 | |
836 | isa_ok( $document, 'PPI::Document' ); |
837 | my $words = $document->find('PPI::Token::Word'); |
838 | is( scalar @{$words}, 1, 'Found expected word token.' ); |
839 | is( $words->[0]->column_number, 4, 'Got correct column number.' ); |
840 | |
841 | =end testing |
842 | |
843 | =cut |
844 | |
845 | sub column_number { |
846 | my $self = shift; |
847 | |
848 | my $location = $self->location() or return undef; |
849 | return $location->[1]; |
850 | } |
851 | |
852 | =pod |
853 | |
854 | =head2 visual_column_number |
855 | |
856 | If the Element exists within a L<PPI::Document> that has indexed the Element |
857 | locations using C<PPI::Document::index_locations>, the C<visual_column_number> |
858 | method will return the visual column number of the first character of the |
859 | Element within the Document, according to the value of |
860 | L<PPI::Document/"tab_width [ $width ]">. |
861 | |
862 | Returns C<undef> on error, or if the L<PPI::Document> object has not been |
863 | indexed. |
864 | |
865 | =begin testing visual_column_number 3 |
866 | |
867 | my $document = PPI::Document->new(\<<"END_PERL"); |
868 | |
869 | |
870 | \t foo |
871 | END_PERL |
872 | |
873 | isa_ok( $document, 'PPI::Document' ); |
874 | my $tab_width = 5; |
875 | $document->tab_width($tab_width); # don't use a "usual" value. |
876 | my $words = $document->find('PPI::Token::Word'); |
877 | is( scalar @{$words}, 1, 'Found expected word token.' ); |
878 | is( |
879 | $words->[0]->visual_column_number, |
880 | $tab_width + 2, |
881 | 'Got correct visual column number.', |
882 | ); |
883 | |
884 | =end testing |
885 | |
886 | =cut |
887 | |
888 | sub visual_column_number { |
889 | my $self = shift; |
890 | |
891 | my $location = $self->location() or return undef; |
892 | return $location->[2]; |
893 | } |
894 | |
895 | =pod |
896 | |
897 | =head2 logical_line_number |
898 | |
899 | If the Element exists within a L<PPI::Document> that has indexed the Element |
900 | locations using C<PPI::Document::index_locations>, the C<logical_line_number> |
901 | method will return the line number of the first character of the Element within |
902 | the Document, taking into account any C<#line> directives. |
903 | |
904 | Returns C<undef> on error, or if the L<PPI::Document> object has not been |
905 | indexed. |
906 | |
907 | =begin testing logical_line_number 3 |
908 | |
909 | # Double quoted so that we don't really have a "#line" at the beginning and |
910 | # errors in this file itself aren't affected by this. |
911 | my $document = PPI::Document->new(\<<"END_PERL"); |
912 | |
913 | |
914 | \#line 1 test-file |
915 | foo |
916 | END_PERL |
917 | |
918 | isa_ok( $document, 'PPI::Document' ); |
919 | my $words = $document->find('PPI::Token::Word'); |
920 | is( scalar @{$words}, 1, 'Found expected word token.' ); |
921 | is( $words->[0]->logical_line_number, 1, 'Got correct logical line number.' ); |
922 | |
923 | =end testing |
924 | |
925 | =cut |
926 | |
927 | sub logical_line_number { |
928 | my $self = shift; |
929 | |
930 | return $self->location()->[3]; |
931 | } |
932 | |
933 | =pod |
934 | |
935 | =head2 logical_filename |
936 | |
937 | If the Element exists within a L<PPI::Document> that has indexed the Element |
938 | locations using C<PPI::Document::index_locations>, the C<logical_filename> |
939 | method will return the logical file name containing the first character of the |
940 | Element within the Document, taking into account any C<#line> directives. |
941 | |
942 | Returns C<undef> on error, or if the L<PPI::Document> object has not been |
943 | indexed. |
944 | |
945 | =begin testing logical_filename 3 |
946 | |
947 | # Double quoted so that we don't really have a "#line" at the beginning and |
948 | # errors in this file itself aren't affected by this. |
949 | my $document = PPI::Document->new(\<<"END_PERL"); |
950 | |
951 | |
952 | \#line 1 test-file |
953 | foo |
954 | END_PERL |
955 | |
956 | isa_ok( $document, 'PPI::Document' ); |
957 | my $words = $document->find('PPI::Token::Word'); |
958 | is( scalar @{$words}, 1, 'Found expected word token.' ); |
959 | is( |
960 | $words->[0]->logical_filename, |
961 | 'test-file', |
962 | 'Got correct logical line number.', |
963 | ); |
964 | |
965 | =end testing |
966 | |
967 | =cut |
968 | |
969 | sub logical_filename { |
970 | my $self = shift; |
971 | |
972 | my $location = $self->location() or return undef; |
973 | return $location->[4]; |
974 | } |
975 | |
976 | sub _ensure_location_present { |
977 | my $self = shift; |
978 | |
979 | unless ( exists $self->{_location} ) { |
980 | # Are we inside a normal document? |
981 | my $Document = $self->document or return undef; |
982 | if ( $Document->isa('PPI::Document::Fragment') ) { |
983 | # Because they can't be serialized, document fragments |
984 | # do not support the concept of location. |
985 | return undef; |
986 | } |
987 | |
988 | # Generate the locations. If they need one location, then |
989 | # the chances are they'll want more, and it's better that |
990 | # everything is already pre-generated. |
991 | $Document->index_locations or return undef; |
992 | unless ( exists $self->{_location} ) { |
993 | # erm... something went very wrong here |
994 | return undef; |
995 | } |
996 | } |
997 | |
998 | return 1; |
999 | } |
1000 | |
1001 | # Although flush_locations is only publically a Document-level method, |
1002 | # we are able to implement it at an Element level, allowing us to |
1003 | # selectively flush only the part of the document that occurs after the |
1004 | # element for which the flush is called. |
1005 | sub _flush_locations { |
1006 | my $self = shift; |
1007 | unless ( $self == $self->top ) { |
1008 | return $self->top->_flush_locations( $self ); |
1009 | } |
1010 | |
1011 | # Get the full list of all Tokens |
1012 | my @Tokens = $self->tokens; |
1013 | |
1014 | # Optionally allow starting from an arbitrary element (or rather, |
1015 | # the first Token equal-to-or-within an arbitrary element) |
1016 | if ( _INSTANCE($_[0], 'PPI::Element') ) { |
1017 | my $start = shift->first_token; |
1018 | while ( my $Token = shift @Tokens ) { |
1019 | return 1 unless $Token->{_location}; |
1020 | next unless refaddr($Token) == refaddr($start); |
1021 | |
1022 | # Found the start. Flush it's location |
1023 | delete $$Token->{_location}; |
1024 | last; |
1025 | } |
1026 | } |
1027 | |
1028 | # Iterate over any remaining Tokens and flush their location |
1029 | foreach my $Token ( @Tokens ) { |
1030 | delete $Token->{_location}; |
1031 | } |
1032 | |
1033 | 1; |
1034 | } |
1035 | |
1036 | |
1037 | |
1038 | |
1039 | |
1040 | ##################################################################### |
1041 | # XML Compatibility Methods |
1042 | |
1043 | sub _xml_name { |
1044 | my $class = ref $_[0] || $_[0]; |
1045 | my $name = lc join( '_', split /::/, $class ); |
1046 | substr($name, 4); |
1047 | } |
1048 | |
1049 | sub _xml_attr { |
1050 | return {}; |
1051 | } |
1052 | |
1053 | sub _xml_content { |
1054 | defined $_[0]->{content} ? $_[0]->{content} : ''; |
1055 | } |
1056 | |
1057 | |
1058 | |
1059 | |
1060 | |
1061 | ##################################################################### |
1062 | # Internals |
1063 | |
1064 | # Set the error string |
1065 | sub _error { |
1066 | $errstr = $_[1]; |
1067 | undef; |
1068 | } |
1069 | |
1070 | # Clear the error string |
1071 | sub _clear { |
1072 | $errstr = ''; |
1073 | $_[0]; |
1074 | } |
1075 | |
1076 | # Being DESTROYed in this manner, rather than by an explicit |
1077 | # ->delete means our reference count has probably fallen to zero. |
1078 | # Therefore we don't need to remove ourselves from our parent, |
1079 | # just the index ( just in case ). |
1080 | ### XS -> PPI/XS.xs:_PPI_Element__DESTROY 0.900+ |
1081 | sub DESTROY { delete $_PARENT{refaddr $_[0]} } |
1082 | |
1083 | # Operator overloads |
1084 | sub __equals { ref $_[1] and refaddr($_[0]) == refaddr($_[1]) } |
1085 | sub __nequals { !__equals(@_) } |
1086 | sub __eq { |
1087 | my $self = _INSTANCE($_[0], 'PPI::Element') ? $_[0]->content : $_[0]; |
1088 | my $other = _INSTANCE($_[1], 'PPI::Element') ? $_[1]->content : $_[1]; |
1089 | $self eq $other; |
1090 | } |
1091 | sub __ne { !__eq(@_) } |
1092 | |
1093 | 1; |
1094 | |
1095 | =pod |
1096 | |
1097 | =head1 TO DO |
1098 | |
1099 | It would be nice if C<location> could be used in an ad-hoc manner. That is, |
1100 | if called on an Element within a Document that has not been indexed, it will |
1101 | do a one-off calculation to find the location. It might be very painful if |
1102 | someone started using it a lot, without remembering to index the document, |
1103 | but it would be handy for things that are only likely to use it once, such |
1104 | as error handlers. |
1105 | |
1106 | =head1 SUPPORT |
1107 | |
1108 | See the L<support section|PPI/SUPPORT> in the main module. |
1109 | |
1110 | =head1 AUTHOR |
1111 | |
1112 | Adam Kennedy E<lt>adamk@cpan.orgE<gt> |
1113 | |
1114 | =head1 COPYRIGHT |
1115 | |
1116 | Copyright 2001 - 2009 Adam Kennedy. |
1117 | |
1118 | This program is free software; you can redistribute |
1119 | it and/or modify it under the same terms as Perl itself. |
1120 | |
1121 | The full text of the license can be found in the |
1122 | LICENSE file included with this module. |
1123 | |
1124 | =cut |