Commit | Line | Data |
3fea05b9 |
1 | package PPI::Token::Quote::Double; |
2 | |
3 | =pod |
4 | |
5 | =head1 NAME |
6 | |
7 | PPI::Token::Quote::Double - A standard "double quote" token |
8 | |
9 | =head1 INHERITANCE |
10 | |
11 | PPI::Token::Quote::Double |
12 | isa PPI::Token::Quote |
13 | isa PPI::Token |
14 | isa PPI::Element |
15 | |
16 | =head1 DESCRIPTION |
17 | |
18 | A C<PPI::Token::Quote::Double> object represents a double-quoted |
19 | interpolating string. |
20 | |
21 | The string is treated as a single entity, L<PPI> will not try to |
22 | understand what is in the string during the parsing process. |
23 | |
24 | =head1 METHODS |
25 | |
26 | There are several methods available for C<PPI::Token::Quote::Double>, beyond |
27 | those provided by the parent L<PPI::Token::Quote>, L<PPI::Token> and |
28 | L<PPI::Element> classes. |
29 | |
30 | Got any ideas for methods? Submit a report to rt.cpan.org! |
31 | |
32 | =cut |
33 | |
34 | use strict; |
35 | use Params::Util qw{_INSTANCE}; |
36 | use PPI::Token::Quote (); |
37 | use PPI::Token::_QuoteEngine::Simple (); |
38 | |
39 | use vars qw{$VERSION @ISA}; |
40 | BEGIN { |
41 | $VERSION = '1.206'; |
42 | @ISA = qw{ |
43 | PPI::Token::_QuoteEngine::Simple |
44 | PPI::Token::Quote |
45 | }; |
46 | } |
47 | |
48 | |
49 | |
50 | |
51 | |
52 | ##################################################################### |
53 | # PPI::Token::Quote::Double Methods |
54 | |
55 | =pod |
56 | |
57 | =head2 interpolations |
58 | |
59 | The interpolations method checks to see if the double quote actually |
60 | contains any interpolated variables. |
61 | |
62 | Returns true if the string contains interpolations, or false if not. |
63 | |
64 | =begin testing interpolations 8 |
65 | |
66 | # Get a set of objects |
67 | my $Document = PPI::Document->new(\<<'END_PERL'); |
68 | "no interpolations" |
69 | "no \@interpolations" |
70 | "has $interpolation" |
71 | "has @interpolation" |
72 | "has \\@interpolation" |
73 | "" # False content to test double-negation scoping |
74 | END_PERL |
75 | isa_ok( $Document, 'PPI::Document' ); |
76 | my $strings = $Document->find('Token::Quote::Double'); |
77 | is( scalar @{$strings}, 6, 'Found the 6 test strings' ); |
78 | is( $strings->[0]->interpolations, '', 'String 1: No interpolations' ); |
79 | is( $strings->[1]->interpolations, '', 'String 2: No interpolations' ); |
80 | is( $strings->[2]->interpolations, 1, 'String 3: Has interpolations' ); |
81 | is( $strings->[3]->interpolations, 1, 'String 4: Has interpolations' ); |
82 | is( $strings->[4]->interpolations, 1, 'String 5: Has interpolations' ); |
83 | is( $strings->[5]->interpolations, '', 'String 6: No interpolations' ); |
84 | |
85 | =end testing |
86 | |
87 | =cut |
88 | |
89 | # Upgrade: Return the interpolated substrings. |
90 | # Upgrade: Returns parsed expressions. |
91 | sub interpolations { |
92 | # Are there any unescaped $things in the string |
93 | !! ($_[0]->content =~ /(?<!\\)(?:\\\\)*[\$\@]/); |
94 | } |
95 | |
96 | =pod |
97 | |
98 | =head2 simplify |
99 | |
100 | For various reasons, some people find themselves compelled to have |
101 | their code in the simplest form possible. |
102 | |
103 | The C<simply> method will turn a simple double-quoted string into the |
104 | equivalent single-quoted string. |
105 | |
106 | If the double can be simplified, it will be modified in place and |
107 | returned as a convenience, or returns false if the string cannot be |
108 | simplified. |
109 | |
110 | =begin testing simplify 8 |
111 | |
112 | my $Document = PPI::Document->new(\<<'END_PERL'); |
113 | "no special characters" |
114 | "has \"double\" quotes" |
115 | "has 'single' quotes" |
116 | "has $interpolation" |
117 | "has @interpolation" |
118 | "" |
119 | END_PERL |
120 | isa_ok( $Document, 'PPI::Document' ); |
121 | my $strings = $Document->find('Token::Quote::Double'); |
122 | is( scalar @{$strings}, 6, 'Found the 6 test strings' ); |
123 | is( $strings->[0]->simplify, q<'no special characters'>, 'String 1: No special characters' ); |
124 | is( $strings->[1]->simplify, q<"has \"double\" quotes">, 'String 2: Double quotes' ); |
125 | is( $strings->[2]->simplify, q<"has 'single' quotes">, 'String 3: Single quotes' ); |
126 | is( $strings->[3]->simplify, q<"has $interpolation">, 'String 3: Has interpolation' ); |
127 | is( $strings->[4]->simplify, q<"has @interpolation">, 'String 4: Has interpolation' ); |
128 | is( $strings->[5]->simplify, q<''>, 'String 6: Empty string' ); |
129 | |
130 | =end testing |
131 | |
132 | =cut |
133 | |
134 | sub simplify { |
135 | # This only works on EXACTLY this class |
136 | my $self = _INSTANCE(shift, 'PPI::Token::Quote::Double') or return undef; |
137 | |
138 | # Don't bother if there are characters that could complicate things |
139 | my $content = $self->content; |
140 | my $value = substr($content, 1, length($content) - 2); |
141 | return $self if $value =~ /[\\\$@\'\"]/; |
142 | |
143 | # Change the token to a single string |
144 | $self->{content} = "'$value'"; |
145 | bless $self, 'PPI::Token::Quote::Single'; |
146 | } |
147 | |
148 | |
149 | |
150 | |
151 | |
152 | |
153 | |
154 | ##################################################################### |
155 | # PPI::Token::Quote Methods |
156 | |
157 | =pod |
158 | |
159 | =begin testing string 3 |
160 | |
161 | my $Document = PPI::Document->new( \'print "foo";' ); |
162 | isa_ok( $Document, 'PPI::Document' ); |
163 | my $Double = $Document->find_first('Token::Quote::Double'); |
164 | isa_ok( $Double, 'PPI::Token::Quote::Double' ); |
165 | is( $Double->string, 'foo', '->string returns as expected' ); |
166 | |
167 | =end testing |
168 | |
169 | =cut |
170 | |
171 | sub string { |
172 | my $str = $_[0]->{content}; |
173 | substr( $str, 1, length($str) - 2 ); |
174 | } |
175 | |
176 | 1; |
177 | |
178 | =pod |
179 | |
180 | =head1 SUPPORT |
181 | |
182 | See the L<support section|PPI/SUPPORT> in the main module. |
183 | |
184 | =head1 AUTHOR |
185 | |
186 | Adam Kennedy E<lt>adamk@cpan.orgE<gt> |
187 | |
188 | =head1 COPYRIGHT |
189 | |
190 | Copyright 2001 - 2009 Adam Kennedy. |
191 | |
192 | This program is free software; you can redistribute |
193 | it and/or modify it under the same terms as Perl itself. |
194 | |
195 | The full text of the license can be found in the |
196 | LICENSE file included with this module. |
197 | |
198 | =cut |