local-lib5/lib/perl5/PPI/Token/Attribute.pm

   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 use strict;
  36 use PPI::Token ();
  37
  38 use vars qw{$VERSION @ISA};
  39 BEGIN {
  40         $VERSION = '1.206';
  41         @ISA     = 'PPI::Token';
  42 }
  43
  44
  45
  46
  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
  87
  88
  89
  90
  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
 139                         $string .= $search;
 140                         $t->_fill_line(1) or return \$string;
 141                         next;
 142                 }
 143
 144                 # Add to the string
 145                 $string .= $1;
 146                 $t->{line_cursor} += length $1;
 147
 148                 # Alter the depth and continue if we arn't at the end
 149                 $depth += ($1 =~ /\($/) ? 1 : -1 and next;
 150
 151                 # Found the end
 152                 return $string;
 153         }
 154
 155         # Returning the string as a reference indicates EOF
 156         \$string;
 157 }
 158
 159 1;
 160
 161 =pod
 162
 163 =head1 SUPPORT
 164
 165 See the L<support section|PPI/SUPPORT> in the main module.
 166
 167 =head1 AUTHOR
 168
 169 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 170
 171 =head1 COPYRIGHT
 172
 173 Copyright 2001 - 2009 Adam Kennedy.
 174
 175 This program is free software; you can redistribute
 176 it and/or modify it under the same terms as Perl itself.
 177
 178 The full text of the license can be found in the
 179 LICENSE file included with this module.
 180
 181 =cut