local-lib5/lib/perl5/PPI/Token/Quote/Double.pm

   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