1package MDOM::Token; 2 3=pod 4 5=head1 NAME 6 7MDOM::Token - A single token of Makefile source code 8 9=head1 INHERITANCE 10 11 MDOM::Token 12 isa MDOM::Element 13 14=head1 DESCRIPTION 15 16C<MDOM::Token> is the abstract base class for all Tokens. In MDOM terms, a "Token" is 17a L<MDOM::Element> that directly represents bytes of source code. 18 19The implementation and POD are borrowed directly from L<PPI::Token>. 20 21=head1 METHODS 22 23=cut 24 25use strict; 26use base 'MDOM::Element'; 27use Params::Util '_INSTANCE'; 28 29use vars qw{$VERSION}; 30BEGIN { 31 $VERSION = '0.008'; 32} 33 34# We don't load the abstracts, they are loaded 35# as part of the 'use base' statements. 36 37# Load the token classes 38use MDOM::Token::Whitespace (); 39use MDOM::Token::Comment (); 40use MDOM::Token::Separator (); 41use MDOM::Token::Continuation (); 42use MDOM::Token::Bare (); 43use MDOM::Token::Interpolation (); 44use MDOM::Token::Modifier (); 45 46##################################################################### 47# Constructor and Related 48 49sub new { 50 if ( @_ == 2 ) { 51 # MDOM::Token->new( $content ); 52 my $class; 53 if ($_[0] eq __PACKAGE__) { 54 $class = 'MDOM::Token::Bare'; 55 shift; 56 } else { 57 $class = shift; 58 } 59 return bless { 60 content => (defined $_[0] ? "$_[0]" : ''), 61 lineno => $., 62 }, $class; 63 } elsif ( @_ == 3 ) { 64 # MDOM::Token->new( $class, $content ); 65 my $class = substr( $_[0], 0, 12 ) eq 'MDOM::Token::' ? $_[1] : "MDOM::Token::$_[1]"; 66 return bless { 67 content => (defined $_[2] ? "$_[2]" : ''), 68 lineno => $., 69 }, $class; 70 } 71 72 # Invalid argument count 73 undef; 74} 75 76=head2 set_class 77 78Set a specific class for a token. 79 80=cut 81 82sub set_class { 83 my $self = shift; @_ or return undef; 84 my $class = substr( $_[0], 0, 12 ) eq 'MDOM::Token::' ? shift : 'MDOM::Token::' . shift; 85 86 # Find out if the current and new classes are complex 87 my $old_quote = (ref($self) =~ /\b(?:Quote|Regex)\b/o) ? 1 : 0; 88 my $new_quote = ($class =~ /\b(?:Quote|Regex)\b/o) ? 1 : 0; 89 90 # No matter what happens, we will have to rebless 91 bless $self, $class; 92 93 # If we are changing to or from a Quote style token, we 94 # can't just rebless and need to do some extra thing 95 # Otherwise, we have done enough 96 return 1 if ($old_quote - $new_quote) == 0; 97 98 # Make a new token from the old content, and overwrite the current 99 # token's attributes with the new token's attributes. 100 my $token = $class->new( $self->{content} ) or return undef; 101 delete $self->{$_} foreach keys %$self; 102 $self->{$_} = $token->{$_} foreach keys %$token; 103 104 1; 105} 106 107 108 109##################################################################### 110# MDOM::Token Methods 111 112=pod 113 114=head2 set_content $string 115 116The C<set_content> method allows to set/change the string that the 117C<MDOM::Token> object represents. 118 119Returns the string you set the Token to 120 121=cut 122 123sub set_content { 124 $_[0]->{content} = $_[1]; 125} 126 127=pod 128 129=head2 add_content $string 130 131The C<add_content> method allows you to add additional bytes of code 132to the end of the Token. 133 134Returns the new full string after the bytes have been added. 135 136=cut 137 138sub add_content { $_[0]->{content} .= $_[1] } 139 140=pod 141 142=head2 length 143 144The C<length> method returns the length of the string in a Token. 145 146=cut 147 148sub length { &CORE::length($_[0]->{content}) } 149 150 151 152 153 154##################################################################### 155# Overloaded MDOM::Element methods 156 157sub content { 158 $_[0]->{content}; 159} 160 161# You can insert either a statement, or a non-significant token. 162sub insert_before { 163 my $self = shift; 164 my $Element = _INSTANCE(shift, 'MDOM::Element') or return undef; 165 if ( $Element->isa('MDOM::Structure') ) { 166 return $self->__insert_before($Element); 167 } elsif ( $Element->isa('MDOM::Token') ) { 168 return $self->__insert_before($Element); 169 } 170 ''; 171} 172 173# As above, you can insert a statement, or a non-significant token 174sub insert_after { 175 my $self = shift; 176 my $Element = _INSTANCE(shift, 'MDOM::Element') or return undef; 177 if ( $Element->isa('MDOM::Structure') ) { 178 return $self->__insert_after($Element); 179 } elsif ( $Element->isa('MDOM::Token') ) { 180 return $self->__insert_after($Element); 181 } 182 ''; 183} 184 185=pod 186 187=head2 source 188 189Returns the makefile source for the current token 190 191=cut 192 193sub source { 194 my $self = shift; 195 return $self->content; 196} 197 1981; 199