File Coverage

blib/lib/MDOM/Node.pm
Criterion Covered Total %
statement 147 229 64.1
branch 48 114 42.1
condition 5 12 41.6
subroutine 30 43 69.7
pod 20 21 95.2
total 250 419 59.6


line stmt bran cond sub pod time code
1             package MDOM::Node;
2              
3             =pod
4              
5             =head1 NAME
6              
7             MDOM::Node - Abstract MDOM Node class, an Element that can contain other Elements
8              
9             =head1 INHERITANCE
10              
11             MDOM::Node
12             isa MDOM::Element
13              
14             =head1 SYNOPSIS
15              
16             # Create a typical node (a Document in this case)
17             my $Node = MDOM::Document->new;
18              
19             # Add an element to the node( in this case, a token )
20             my $Token = MDOM::Token::Word->new('my');
21             $Node->add_element( $Token );
22              
23             # Get the elements for the Node
24             my @elements = $Node->children;
25              
26             # Find all the barewords within a Node
27             my $barewords = $Node->find( 'MDOM::Token::Word' );
28              
29             # Find by more complex criteria
30             my $my_tokens = $Node->find( sub { $_[1]->content eq 'my' } );
31              
32             # Remove all the whitespace
33             $Node->prune( 'MDOM::Token::Whitespace' );
34              
35             # Remove by more complex criteria
36             $Node->prune( sub { $_[1]->content eq 'my' } );
37              
38             =head1 DESCRIPTION
39              
40             The C class provides an abstract base class for the Element
41             classes that are able to contain other elements L,
42             L, and L.
43              
44             As well as those listed below, all of the methods that apply to
45             L objects also apply to C objects.
46              
47             =head1 METHODS
48              
49             =cut
50              
51 17     17   87 use strict;
  17         31  
  17         718  
52 17     17   90 use base 'MDOM::Element';
  17         30  
  17         396  
53 17     17   101 use Carp ();
  17         29  
  17         361  
54 17     17   81 use Scalar::Util 'refaddr';
  17         32  
  17         806  
55 17     17   9843 use List::MoreUtils ();
  17         16111  
  17         462  
56 17         934 use Params::Util '_INSTANCE',
57 17     17   100 '_CLASS';
  17         26  
58              
59 17     17   83 use vars qw{$VERSION *_PARENT};
  17         24  
  17         930  
60             BEGIN {
61 17     17   39 $VERSION = '0.008';
62 17         41831 *_PARENT = *MDOM::Element::_PARENT;
63             }
64              
65              
66              
67              
68              
69             #####################################################################
70             # The basic constructor
71              
72             sub new {
73 201   33 201 0 606 my $class = ref $_[0] || $_[0];
74 201         1006 bless { children => [], lineno => $. }, $class;
75             }
76              
77              
78             #####################################################################
79             # PDOM Methods
80              
81             =pod
82              
83             =head2 scope
84              
85             The C method returns true if the node represents a lexical scope
86             boundary, or false if it does not.
87              
88             =cut
89              
90             ### XS -> MDOM/XS.xs:_MDOM_Node__scope 0.903+
91 0     0 1 0 sub scope { '' }
92              
93             =pod
94              
95             =head2 add_element $Element
96              
97             The C method adds a L object to the end of a
98             C. Because Elements maintain links to their parent, an
99             Element can only be added to a single Node.
100              
101             Returns true if the L was added. Returns C if the
102             Element was already within another Node, or the method is not passed
103             a L object.
104              
105             =cut
106              
107             sub add_element {
108 3     3 1 8 my $self = shift;
109              
110             # Check the element
111 3 50       124 my $Element = _INSTANCE(shift, 'MDOM::Element') or return undef;
112 3 50       16 $_PARENT{refaddr $Element} and return undef;
113              
114             # Add the argument to the elements
115 3         4 push @{$self->{children}}, $Element;
  3         53  
116 3         18 Scalar::Util::weaken(
117             $_PARENT{refaddr $Element} = $self
118             );
119              
120 3         4 1;
121             }
122              
123             # In a typical run profile, add_element is the number 1 resource drain.
124             # This is a highly optimised unsafe version, for internal use only.
125             sub __add_element {
126 864     864   2589 Scalar::Util::weaken(
127             $_PARENT{refaddr $_[1]} = $_[0]
128             );
129 864         609 push @{$_[0]->{children}}, $_[1];
  864         5436  
130             }
131              
132             sub __add_elements {
133 232     232   252 my $self = shift;
134 232         393 for (@_) { $self->__add_element($_); }
  814         1094  
135             }
136              
137             =pod
138              
139             =head2 elements
140              
141             The C method accesses all child elements B within
142             the C object. Note that in the base of the L
143             classes, this C include the brace tokens at either end of the
144             structure.
145              
146             Returns a list of zero or more L objects.
147              
148             Alternatively, if called in the scalar context, the C method
149             returns a count of the number of elements.
150              
151             =cut
152              
153             sub elements {
154 13 100   13 1 38 wantarray ? @{$_[0]->{children}} : scalar @{$_[0]->{children}};
  11         56  
  2         10  
155             }
156              
157             =pod
158              
159             =head2 first_element
160              
161             The C method accesses the first element structurally within
162             the C object. As for the C method, this does include
163             the brace tokens for L objects.
164              
165             Returns a L object, or C if for some reason the
166             C object does not contain any elements.
167              
168             =cut
169              
170             # Normally the first element is also the first child
171             sub first_element {
172 2     2 1 9 $_[0]->{children}->[0];
173             }
174              
175             =pod
176              
177             =head2 last_element
178              
179             The C method accesses the last element structurally within
180             the C object. As for the C method, this does include
181             the brace tokens for L objects.
182              
183             Returns a L object, or C if for some reason the
184             C object does not contain any elements.
185              
186             =cut
187              
188             # Normally the last element is also the last child
189             sub last_element {
190 84     84 1 393 $_[0]->{children}->[-1];
191             }
192              
193             =pod
194              
195             =head2 children
196              
197             The C method accesses all child elements lexically within the
198             C object. Note that in the case of the L
199             classes, this does B include the brace tokens at either end of the
200             structure.
201              
202             Returns a list of zero of more L objects.
203              
204             Alternatively, if called in the scalar context, the C method
205             returns a count of the number of lexical children.
206              
207             =cut
208              
209             # In the default case, this is the same as for the elements method
210             sub children {
211 10 50   10 1 18 wantarray ? @{$_[0]->{children}} : scalar @{$_[0]->{children}};
  10         30  
  0         0  
212             }
213              
214             =pod
215              
216             =head2 schildren
217              
218             The C method is really just a convenience, the significant-only
219             variation of the normal C method.
220              
221             In list context, returns a list of significant children. In scalar context,
222             returns the number of significant children.
223              
224             =cut
225              
226             sub schildren {
227 1     1 1 2 my $self = shift;
228 1         4 my @schildren = grep { $_->significant } $self->children;
  3         15  
229 1 50       5 wantarray ? @schildren : scalar(@schildren);
230             }
231              
232             =pod
233              
234             =head2 child $index
235              
236             The C method accesses a child L object by its
237             position within the Node.
238              
239             Returns a L object, or C if there is no child
240             element at that node.
241              
242             =cut
243              
244             sub child {
245 11     11 1 82 $_[0]->{children}->[$_[1]];
246             }
247              
248             =pod
249              
250             =head2 schild $index
251              
252             The lexical structure of the Perl language ignores 'insignificant' items,
253             such as whitespace and comments, while L treats these items as valid
254             tokens so that it can reassemble the file at any time. Because of this,
255             in many situations there is a need to find an Element within a Node by
256             index, only counting lexically significant Elements.
257              
258             The C method returns a child Element by index, ignoring
259             insignificant Elements. The index of a child Element is specified in the
260             same way as for a normal array, with the first Element at index 0, and
261             negative indexes used to identify a "from the end" position.
262              
263             =cut
264              
265             sub schild {
266 2     2 1 3 my $self = shift;
267 2         4 my $idx = 0 + shift;
268 2         4 my $el = $self->{children};
269 2 50       8 if ( $idx < 0 ) {
270 0         0 my $cursor = 0;
271 0         0 while ( exists $el->[--$cursor] ) {
272 0 0 0     0 return $el->[$cursor] if $el->[$cursor]->significant and ++$idx >= 0;
273             }
274             } else {
275 2         4 my $cursor = -1;
276 2         6 while ( exists $el->[++$cursor] ) {
277 4 100 100     12 return $el->[$cursor] if $el->[$cursor]->significant and --$idx < 0;
278             }
279             }
280 0         0 undef;
281             }
282              
283             =pod
284              
285             =head2 contains $Element
286              
287             The C method is used to determine if another L
288             object is logically "within" a C. For the special case of the
289             brace tokens at either side of a L object, they are
290             generally considered "within" a L object, even if they are
291             not actually in the elements for the L.
292              
293             Returns true if the L is within us, false if not, or C
294             on error.
295              
296             =cut
297              
298             sub contains {
299 4     4 1 13 my $self = shift;
300 4 50       142 my $Element = _INSTANCE(shift, 'MDOM::Element') or return undef;
301              
302             # Iterate up the Element's parent chain until we either run out
303             # of parents, or get to ourself.
304 4         18 while ( $Element = $Element->parent ) {
305 2 50       16 return 1 if refaddr($self) == refaddr($Element);
306             }
307              
308 2         10 '';
309             }
310              
311             =pod
312              
313             =head2 find $class | \&wanted
314              
315             The C method is used to search within a code tree for
316             L objects that meet a particular condition.
317              
318             To specify the condition, the method can be provided with either a simple
319             class name (full or shortened), or a C/function reference.
320              
321             # Find all single quotes in a Document (which is a Node)
322             $Document->find('MDOM::Quote::Single');
323              
324             # The same thing with a shortened class name
325             $Document->find('Quote::Single');
326              
327             # Anything more elaborate, we so with the sub
328             $Document->find( sub {
329             # At the top level of the file...
330             $_[1]->parent == $_[0]
331             and (
332             # ...find all comments and POD
333             $_[1]->isa('MDOM::Token::Pod')
334             or
335             $_[1]->isa('MDOM::Token::Comment')
336             )
337             } );
338              
339             The function will be passed two arguments, the top-level C
340             you are searching in and the current L that the condition
341             is testing.
342              
343             The anonymous function should return one of three values. Returning true
344             indicates a condition match, defined-false (C<0> or C<''>) indicates
345             no-match, and C indicates no-match and no-descend.
346              
347             In the last case, the tree walker will skip over anything below the
348             C-returning element and move on to the next element at the same
349             level.
350              
351             To halt the entire search and return C immediately, a condition
352             function should throw an exception (i.e. C).
353              
354             Note that this same wanted logic is used for all methods documented to
355             have a C<\&wanted> parameter, as this one does.
356              
357             The C method returns a reference to an array of L
358             objects that match the condition, false (but defined) if no Elements match
359             the condition, or C if you provide a bad condition, or an error
360             occurs during the search process.
361              
362             In the case of a bad condition, a warning will be emitted as well.
363              
364             =cut
365              
366             sub find {
367 3     3 1 7 my $self = shift;
368 3 50       8 my $wanted = $self->_wanted(shift) or return undef;
369              
370             # Use a queue based search, rather than a recursive one
371 3         5 my @found = ();
372 3         9 my @queue = $self->children;
373 3         6 eval {
374 3         15 while ( my $Element = shift @queue ) {
375 9         215 my $rv = &$wanted( $self, $Element );
376 9 100       20 push @found, $Element if $rv;
377              
378             # Support "don't descend on undef return"
379 9 50       14 next unless defined $rv;
380              
381             # Skip if the Element doesn't have any children
382 9 50       62 next unless $Element->isa('MDOM::Node');
383              
384             # Depth-first keeps the queue size down and provides a
385             # better logical order.
386 0 0       0 if ( $Element->isa('MDOM::Structure') ) {
387 0 0       0 unshift @queue, $Element->finish if $Element->finish;
388 0         0 unshift @queue, $Element->children;
389 0 0       0 unshift @queue, $Element->start if $Element->start;
390             } else {
391 0         0 unshift @queue, $Element->children;
392             }
393             }
394             };
395 3 50       7 if ( $@ ) {
396             # Caught exception thrown from the wanted function
397 0         0 return undef;
398             }
399              
400 3 50       34 @found ? \@found : '';
401             }
402              
403             =pod
404              
405             =head2 find_first $class | \&wanted
406              
407             If the normal C method is like a grep, then C is
408             equivalent to the L C function.
409              
410             Given an element class or a wanted function, it will search depth-first
411             through a tree until it finds something that matches the condition,
412             returning the first Element that it encounters.
413              
414             See the C method for details on the format of the search condition.
415              
416             Returns the first L object that matches the condition, false
417             if nothing matches the condition, or C if given an invalid condition,
418             or an error occurs.
419              
420             =cut
421              
422             sub find_first {
423 2     2 1 6 my $self = shift;
424 2 50       5 my $wanted = $self->_wanted(shift) or return undef;
425              
426             # Use the same queue-based search as for ->find
427 2         6 my @queue = $self->children;
428 2         3 my $rv = eval {
429 2         11 while ( my $Element = shift @queue ) {
430 3         51 my $rv = &$wanted( $self, $Element );
431 3 100       7 return $Element if $rv;
432              
433             # Support "don't descend on undef return"
434 1 50       4 next unless defined $rv;
435              
436             # Skip if the Element doesn't have any children
437 1 50       7 next unless $Element->isa('MDOM::Node');
438              
439             # Depth-first keeps the queue size down and provides a
440             # better logical order.
441 0 0       0 if ( $Element->isa('MDOM::Structure') ) {
442 0 0       0 unshift @queue, $Element->finish if $Element->finish;
443 0         0 unshift @queue, $Element->children;
444 0 0       0 unshift @queue, $Element->start if $Element->start;
445             } else {
446 0         0 unshift @queue, $Element->children;
447             }
448             }
449             };
450 2 50       6 if ( $@ ) {
451             # Caught exception thrown from the wanted function
452 0         0 return undef;
453             }
454              
455 2 50       18 $rv or '';
456             }
457              
458             =pod
459              
460             =head2 find_any $class | \&wanted
461              
462             The C method is a short-circuiting true/false method that behaves
463             like the normal C method, but returns true as soon as it finds any
464             Elements that match the search condition.
465              
466             See the C method for details on the format of the search condition.
467              
468             Returns true if any Elements that match the condition can be found, false if
469             not, or C if given an invalid condition, or an error occurs.
470              
471             =cut
472              
473             sub find_any {
474 0     0 1 0 my $self = shift;
475 0         0 my $rv = $self->find_first(@_);
476 0 0       0 $rv ? 1 : $rv; # false or undef
477             }
478              
479             =pod
480              
481             =head2 remove_child $Element
482              
483             If passed a L object that is a direct child of the Node,
484             the C method will remove the C intact, along
485             with any of its children. As such, this method acts essentially as a
486             'cut' function.
487              
488             =cut
489              
490             sub remove_child {
491 5     5 1 6 my $self = shift;
492 5 50       25 my $child = _INSTANCE(shift, 'MDOM::Element') or return undef;
493              
494             # Find the position of the child
495 5         33 my $key = refaddr $child;
496             my $p = List::MoreUtils::firstidx {
497 7     7   11 refaddr $_ == $key
498 5         12 } @{$self->{children}};
  5         17  
499 5 50       16 return undef unless defined $p;
500              
501             # Splice it out, and remove the child's parent entry
502 5         3 splice( @{$self->{children}}, $p, 1 );
  5         9  
503 5         11 delete $_PARENT{refaddr $child};
504              
505 5         17 $child;
506             }
507              
508             =pod
509              
510             =head2 source
511              
512             Returns the makefile source for the current node
513              
514             =cut
515              
516             sub source {
517 0     0 1 0 my $self = shift;
518 0         0 join '', map { $_->source } $self->children;
  0         0  
519             }
520              
521             =pod
522              
523             =head2 prune $class | \&wanted
524              
525             The C method is used to strip L objects out of a code
526             tree. The argument is the same as for the C method, either a class
527             name, or an anonymous subroutine which returns true/false. Any Element
528             that matches the class|wanted will be deleted from the code tree, along
529             with any of its children.
530              
531             The C method returns the number of C objects that matched
532             and were removed, B. This might also be zero, so avoid a
533             simple true/false test on the return false of the C method. It
534             returns C on error, which you probably B test for.
535              
536             =cut
537              
538             sub prune {
539 3     3 1 11 my $self = shift;
540 3 50       8 my $wanted = $self->_wanted(shift) or return undef;
541              
542             # Use a depth-first queue search
543 3         4 my $pruned = 0;
544 3         8 my @queue = $self->children;
545 3         5 eval {
546 3         13 while ( my $element = shift @queue ) {
547 8         152 my $rv = &$wanted( $self, $element );
548 8 100       14 if ( $rv ) {
549             # Delete the child
550 5 50       24 $element->delete or return undef;
551 5         5 $pruned++;
552 5         13 next;
553             }
554              
555             # Support the undef == "don't descend"
556 3 50       8 next unless defined $rv;
557              
558 3 50       32 if ( _INSTANCE($element, 'MDOM::Node') ) {
559             # Depth-first keeps the queue size down
560 0         0 unshift @queue, $element->children;
561             }
562             }
563             };
564 3 50       7 if ( $@ ) {
565             # Caught exception thrown from the wanted function
566 0         0 return undef;
567             }
568              
569 3         24 $pruned;
570             }
571              
572             # This method is likely to be very heavily used, to take
573             # it slowly and carefuly.
574             ### NOTE: Renaming this function or changing either to self will probably
575             ### break File::Find::Rule::MDOM
576             sub _wanted {
577 8     8   9 my $either = shift;
578 8 50       19 my $it = defined $_[0] ? shift : do {
579 0 0       0 Carp::carp('Undefined value passed as search condition') if $^W;
580 0         0 return undef;
581             };
582              
583             # Has the caller provided a wanted function directly
584 8 50       15 return $it if ref $it eq 'CODE';
585 8 50       17 if ( ref $it ) {
586             # No other ref types are supported
587 0 0       0 Carp::carp('Illegal non-CODE reference passed as search condition') if $^W;
588 0         0 return undef;
589             }
590              
591             # The first argument should be an Element class, possibly in shorthand
592 8 100       27 $it = "MDOM::$it" unless substr($it, 0, 6) eq 'MDOM::';
593 8 50 33     243 unless ( _CLASS($it) and $it->isa('MDOM::Element') ) {
594             # We got something, but it isn't an element
595 0 0       0 Carp::carp("Cannot create search condition for '$it': Not a MDOM::Element") if $^W;
596 0         0 return undef;
597             }
598              
599             # Create the class part of the wanted function
600 8         149 my $wanted_class = "\n\treturn '' unless \$_[1]->isa('$it');";
601              
602             # Have we been given a second argument to check the content
603 8         9 my $wanted_content = '';
604 8 50       18 if ( defined $_[0] ) {
605 0         0 my $content = shift;
606 0 0       0 if ( ref $content eq 'Regexp' ) {
    0          
607 0         0 $content = "$content";
608             } elsif ( ref $content ) {
609             # No other ref types are supported
610 0 0       0 Carp::carp("Cannot create search condition for '$it': Not a MDOM::Element") if $^W;
611 0         0 return undef;
612             } else {
613 0         0 $content = quotemeta $content;
614             }
615              
616             # Complete the content part of the wanted function
617 0         0 $wanted_content .= "\n\treturn '' unless defined \$_[1]->{content};";
618 0         0 $wanted_content .= "\n\treturn '' unless \$_[1]->{content} =~ /$content/;";
619             }
620              
621             # Create the complete wanted function
622 8         13 my $code = "sub {"
623             . $wanted_class
624             . $wanted_content
625             . "\n\t1;"
626             . "\n}";
627              
628             # Compile the wanted function
629 8         609 $code = eval $code;
630 8 50       40 (ref $code eq 'CODE') ? $code : undef;
631             }
632              
633              
634              
635              
636              
637             ####################################################################
638             # MDOM::Element overloaded methods
639              
640             sub tokens {
641 0     0 1 0 map { $_->tokens } @{$_[0]->{children}};
  0         0  
  0         0  
642             }
643              
644             ### XS -> MDOM/XS.xs:_MDOM_Element__content 0.900+
645             sub content {
646 6     6 1 10 join '', map { $_->content } @{$_[0]->{children}};
  12         26  
  6         18  
647             }
648              
649             # Clone as normal, but then go down and relink all the _PARENT entries
650             sub clone {
651 1     1 1 2 my $self = shift;
652 1         12 my $clone = $self->SUPER::clone;
653 1         5 $clone->__link_children;
654 1         3 $clone;
655             }
656              
657             sub location {
658 0     0 1 0 my $self = shift;
659 0 0       0 my $first = $self->{children}->[0] or return undef;
660 0         0 $first->location;
661             }
662              
663              
664              
665              
666              
667             #####################################################################
668             # Internal Methods
669              
670             sub DESTROY {
671 202     202   200 local $_;
672 202 100       515 if ( $_[0]->{children} ) {
673 78         161 my @queue = $_[0];
674 78         262 while ( defined($_ = shift @queue) ) {
675 943 100       1822 unshift @queue, @{delete $_->{children}} if $_->{children};
  202         543  
676              
677             # Remove all internal/private weird crosslinking so that
678             # the cascading DESTROY calls will get called properly.
679 943         2077 %$_ = ();
680             }
681             }
682              
683             # Remove us from our parent node as normal
684 202         824 delete $_PARENT{refaddr $_[0]};
685             }
686              
687             # Find the position of a child
688             sub __position {
689 0     0   0 my $key = refaddr $_[1];
690 0     0   0 List::MoreUtils::firstidx { refaddr $_ == $key } @{$_[0]->{children}};
  0         0  
  0         0  
691             }
692              
693             # Insert one or more elements before a child
694             sub __insert_before_child {
695 0     0   0 my $self = shift;
696 0         0 my $key = refaddr shift;
697             my $p = List::MoreUtils::firstidx {
698 0     0   0 refaddr $_ == $key
699 0         0 } @{$self->{children}};
  0         0  
700 0         0 foreach ( @_ ) {
701 0         0 Scalar::Util::weaken(
702             $_PARENT{refaddr $_} = $self
703             );
704             }
705 0         0 splice( @{$self->{children}}, $p, 0, @_ );
  0         0  
706 0         0 1;
707             }
708              
709             # Insert one or more elements after a child
710             sub __insert_after_child {
711 0     0   0 my $self = shift;
712 0         0 my $key = refaddr shift;
713             my $p = List::MoreUtils::firstidx {
714 0     0   0 refaddr $_ == $key
715 0         0 } @{$self->{children}};
  0         0  
716 0         0 foreach ( @_ ) {
717 0         0 Scalar::Util::weaken(
718             $_PARENT{refaddr $_} = $self
719             );
720             }
721 0         0 splice( @{$self->{children}}, $p + 1, 0, @_ );
  0         0  
722 0         0 1;
723             }
724              
725             # Replace a child
726             sub __replace_child {
727 0     0   0 my $self = shift;
728 0         0 my $key = refaddr shift;
729             my $p = List::MoreUtils::firstidx {
730 0     0   0 refaddr $_ == $key
731 0         0 } @{$self->{children}};
  0         0  
732 0         0 foreach ( @_ ) {
733 0         0 Scalar::Util::weaken(
734             $_PARENT{refaddr $_} = $self
735             );
736             }
737 0         0 splice( @{$self->{children}}, $p, 1, @_ );
  0         0  
738 0         0 1;
739             }
740              
741             # Create PARENT links for an entire tree.
742             # Used when cloning or thawing.
743             sub __link_children {
744 1     1   2 my $self = shift;
745              
746             # Relink all our children ( depth first )
747 1         3 my @queue = ( $self );
748 1         6 while ( my $Node = shift @queue ) {
749             # Link our immediate children
750 1         1 foreach my $Element ( @{$Node->{children}} ) {
  1         5  
751 3         11 Scalar::Util::weaken(
752             $_PARENT{refaddr($Element)} = $Node
753             );
754 3 50       29 unshift @queue, $Element if $Element->isa('MDOM::Node');
755             }
756              
757             # If it's a structure, relink the open/close braces
758 1 50       8 next unless $Node->isa('MDOM::Structure');
759 0 0       0 Scalar::Util::weaken(
760             $_PARENT{refaddr($Node->start)} = $Node
761             ) if $Node->start;
762 0 0       0 Scalar::Util::weaken(
763             $_PARENT{refaddr($Node->finish)} = $Node
764             ) if $Node->finish;
765             }
766              
767 1         1 1;
768             }
769              
770             1;
771              
772             =pod
773              
774             =head1 TO DO
775              
776             - Move as much as possible to L
777              
778             =head1 SUPPORT
779              
780             See the L in the main module.
781              
782             =head1 AUTHOR
783              
784             Adam Kennedy Eadamk@cpan.orgE
785              
786             =head1 COPYRIGHT
787              
788             Copyright 2001 - 2006 Adam Kennedy.
789              
790             This program is free software; you can redistribute
791             it and/or modify it under the same terms as Perl itself.
792              
793             The full text of the license can be found in the
794             LICENSE file included with this module.
795              
796             =cut