| Filename | /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/PPI/Token/Attribute.pm |
| Statements | Executed 9 statements in 499µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 20µs | 37µs | PPI::Token::Attribute::BEGIN@35 |
| 1 | 1 | 1 | 11µs | 11µs | PPI::Token::Attribute::BEGIN@39 |
| 1 | 1 | 1 | 8µs | 46µs | PPI::Token::Attribute::BEGIN@38 |
| 1 | 1 | 1 | 4µs | 4µs | PPI::Token::Attribute::BEGIN@36 |
| 0 | 0 | 0 | 0s | 0s | PPI::Token::Attribute::__TOKENIZER__on_char |
| 0 | 0 | 0 | 0s | 0s | PPI::Token::Attribute::__TOKENIZER__scan_for_end |
| 0 | 0 | 0 | 0s | 0s | PPI::Token::Attribute::identifier |
| 0 | 0 | 0 | 0s | 0s | PPI::Token::Attribute::parameters |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package PPI::Token::Attribute; | ||||
| 2 | |||||
| 3 | =pod | ||||
| 4 | |||||
| 5 | =head1 NAME | ||||
| 6 | |||||
| 7 | PPI::Token::Attribute - A token for a subroutine attribute | ||||
| 8 | |||||
| 9 | =head1 INHERITANCE | ||||
| 10 | |||||
| 11 | PPI::Token::Attribute | ||||
| 12 | isa PPI::Token | ||||
| 13 | isa PPI::Element | ||||
| 14 | |||||
| 15 | =head1 DESCRIPTION | ||||
| 16 | |||||
| 17 | In Perl, attributes are a relatively recent addition to the language. | ||||
| 18 | |||||
| 19 | Given the code C< sub foo : bar(something) {} >, the C<bar(something)> | ||||
| 20 | part is the attribute. | ||||
| 21 | |||||
| 22 | A C<PPI::Token::Attribute> token represents the entire of the attribute, | ||||
| 23 | as the braces and its contents are not parsed into the tree, and are | ||||
| 24 | treated by Perl (and thus by us) as a single string. | ||||
| 25 | |||||
| 26 | =head1 METHODS | ||||
| 27 | |||||
| 28 | This class provides some additional methods beyond those provided by its | ||||
| 29 | L<PPI::Token> and L<PPI::Element> parent classes. | ||||
| 30 | |||||
| 31 | Got any ideas for methods? Submit a report to rt.cpan.org! | ||||
| 32 | |||||
| 33 | =cut | ||||
| 34 | |||||
| 35 | 2 | 27µs | 2 | 53µs | # spent 37µs (20+17) within PPI::Token::Attribute::BEGIN@35 which was called:
# once (20µs+17µs) by PPI::Token::BEGIN@75 at line 35 # spent 37µs making 1 call to PPI::Token::Attribute::BEGIN@35
# spent 17µs making 1 call to strict::import |
| 36 | 2 | 26µs | 1 | 4µs | # spent 4µs within PPI::Token::Attribute::BEGIN@36 which was called:
# once (4µs+0s) by PPI::Token::BEGIN@75 at line 36 # spent 4µs making 1 call to PPI::Token::Attribute::BEGIN@36 |
| 37 | |||||
| 38 | 2 | 38µs | 2 | 85µs | # spent 46µs (8+38) within PPI::Token::Attribute::BEGIN@38 which was called:
# once (8µs+38µs) by PPI::Token::BEGIN@75 at line 38 # spent 46µs making 1 call to PPI::Token::Attribute::BEGIN@38
# spent 38µs making 1 call to vars::import |
| 39 | # spent 11µs within PPI::Token::Attribute::BEGIN@39 which was called:
# once (11µs+0s) by PPI::Token::BEGIN@75 at line 42 | ||||
| 40 | 1 | 400ns | $VERSION = '1.215'; | ||
| 41 | 1 | 11µs | @ISA = 'PPI::Token'; | ||
| 42 | 1 | 394µs | 1 | 11µs | } # spent 11µs making 1 call to PPI::Token::Attribute::BEGIN@39 |
| 43 | |||||
| - - | |||||
| 47 | ##################################################################### | ||||
| 48 | # PPI::Token::Attribute Methods | ||||
| 49 | |||||
| 50 | =pod | ||||
| 51 | |||||
| 52 | =head2 identifier | ||||
| 53 | |||||
| 54 | The C<identifier> attribute returns the identifier part of the attribute. | ||||
| 55 | |||||
| 56 | That is, for the attribute C<foo(bar)>, the C<identifier> method would | ||||
| 57 | return C<"foo">. | ||||
| 58 | |||||
| 59 | =cut | ||||
| 60 | |||||
| 61 | sub identifier { | ||||
| 62 | my $self = shift; | ||||
| 63 | $self->{content} =~ /^(.+?)\(/ ? $1 : $self->{content}; | ||||
| 64 | } | ||||
| 65 | |||||
| 66 | =pod | ||||
| 67 | |||||
| 68 | =head2 parameters | ||||
| 69 | |||||
| 70 | The C<parameters> method returns the parameter strong for the attribute. | ||||
| 71 | |||||
| 72 | That is, for the attribute C<foo(bar)>, the C<parameters> method would | ||||
| 73 | return C<"bar">. | ||||
| 74 | |||||
| 75 | Returns the parameters as a string (including the null string C<''> for | ||||
| 76 | the case of an attribute such as C<foo()>. | ||||
| 77 | |||||
| 78 | Returns C<undef> if the attribute does not have parameters. | ||||
| 79 | |||||
| 80 | =cut | ||||
| 81 | |||||
| 82 | sub parameters { | ||||
| 83 | my $self = shift; | ||||
| 84 | $self->{content} =~ /\((.+)\)$/ ? $1 : undef; | ||||
| 85 | } | ||||
| 86 | |||||
| - - | |||||
| 91 | ##################################################################### | ||||
| 92 | # Tokenizer Methods | ||||
| 93 | |||||
| 94 | sub __TOKENIZER__on_char { | ||||
| 95 | my $class = shift; | ||||
| 96 | my $t = shift; | ||||
| 97 | my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); | ||||
| 98 | |||||
| 99 | # Unless this is a '(', we are finished. | ||||
| 100 | unless ( $char eq '(' ) { | ||||
| 101 | # Finalise and recheck | ||||
| 102 | return $t->_finalize_token->__TOKENIZER__on_char( $t ); | ||||
| 103 | } | ||||
| 104 | |||||
| 105 | # This is a bar(...) style attribute. | ||||
| 106 | # We are currently on the ( so scan in until the end. | ||||
| 107 | # We finish on the character AFTER our end | ||||
| 108 | my $string = $class->__TOKENIZER__scan_for_end( $t ); | ||||
| 109 | if ( ref $string ) { | ||||
| 110 | # EOF | ||||
| 111 | $t->{token}->{content} .= $$string; | ||||
| 112 | $t->_finalize_token; | ||||
| 113 | return 0; | ||||
| 114 | } | ||||
| 115 | |||||
| 116 | # Found the end of the attribute | ||||
| 117 | $t->{token}->{content} .= $string; | ||||
| 118 | $t->_finalize_token->__TOKENIZER__on_char( $t ); | ||||
| 119 | } | ||||
| 120 | |||||
| 121 | # Scan for a close braced, and take into account both escaping, | ||||
| 122 | # and open close bracket pairs in the string. When complete, the | ||||
| 123 | # method leaves the line cursor on the LAST character found. | ||||
| 124 | sub __TOKENIZER__scan_for_end { | ||||
| 125 | my $t = $_[1]; | ||||
| 126 | |||||
| 127 | # Loop as long as we can get new lines | ||||
| 128 | my $string = ''; | ||||
| 129 | my $depth = 0; | ||||
| 130 | while ( exists $t->{line} ) { | ||||
| 131 | # Get the search area | ||||
| 132 | my $search = $t->{line_cursor} | ||||
| 133 | ? substr( $t->{line}, $t->{line_cursor} ) | ||||
| 134 | : $t->{line}; | ||||
| 135 | |||||
| 136 | # Look for a match | ||||
| 137 | unless ( $search =~ /^((?:\\.|[^()])*?[()])/ ) { | ||||
| 138 | # Load in the next line and push to first character | ||||
| 139 | $string .= $search; | ||||
| 140 | $t->_fill_line(1) or return \$string; | ||||
| 141 | $t->{line_cursor} = 0; | ||||
| 142 | next; | ||||
| 143 | } | ||||
| 144 | |||||
| 145 | # Add to the string | ||||
| 146 | $string .= $1; | ||||
| 147 | $t->{line_cursor} += length $1; | ||||
| 148 | |||||
| 149 | # Alter the depth and continue if we arn't at the end | ||||
| 150 | $depth += ($1 =~ /\($/) ? 1 : -1 and next; | ||||
| 151 | |||||
| 152 | # Found the end | ||||
| 153 | return $string; | ||||
| 154 | } | ||||
| 155 | |||||
| 156 | # Returning the string as a reference indicates EOF | ||||
| 157 | \$string; | ||||
| 158 | } | ||||
| 159 | |||||
| 160 | 1 | 2µs | 1; | ||
| 161 | |||||
| 162 | =pod | ||||
| 163 | |||||
| 164 | =head1 SUPPORT | ||||
| 165 | |||||
| 166 | See the L<support section|PPI/SUPPORT> in the main module. | ||||
| 167 | |||||
| 168 | =head1 AUTHOR | ||||
| 169 | |||||
| 170 | Adam Kennedy E<lt>adamk@cpan.orgE<gt> | ||||
| 171 | |||||
| 172 | =head1 COPYRIGHT | ||||
| 173 | |||||
| 174 | Copyright 2001 - 2011 Adam Kennedy. | ||||
| 175 | |||||
| 176 | This program is free software; you can redistribute | ||||
| 177 | it and/or modify it under the same terms as Perl itself. | ||||
| 178 | |||||
| 179 | The full text of the license can be found in the | ||||
| 180 | LICENSE file included with this module. | ||||
| 181 | |||||
| 182 | =cut |