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

   1 package PPI::Token::DashedWord;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 PPI::Token::DashedWord - A dashed bareword token
   8
   9 =head1 INHERITANCE
  10
  11   PPI::Token::DashedWord
  12   isa PPI::Token
  13       isa PPI::Element
  14
  15 =head1 DESCRIPTION
  16
  17 The "dashed bareword" token represents literal values like C<-foo>.
  18
  19 NOTE: this class is currently unused.  All tokens that should be
  20 PPI::Token::DashedWords are just normal PPI::Token::Word instead.
  21 That actually makes sense, since there really is nothing special about
  22 this class except that dashed words cannot be subroutine names or
  23 keywords.  As such, this class may be removed from PPI in the future.
  24
  25 =head1 METHODS
  26
  27 =cut
  28
  29 use strict;
  30 use PPI::Token ();
  31
  32 use vars qw{$VERSION @ISA};
  33 BEGIN {
  34         $VERSION = '1.206';
  35         @ISA     = 'PPI::Token';
  36 }
  37
  38 =pod
  39
  40 =head2 literal
  41
  42 Returns the value of the dashed word as a string.  This differs from
  43 C<content> because C<-Foo'Bar> expands to C<-Foo::Bar>.
  44
  45 =begin testing literal 9
  46
  47 my @pairs = (
  48         "-foo",        '-foo',
  49         "-Foo::Bar",   '-Foo::Bar',
  50         "-Foo'Bar",    '-Foo::Bar',
  51 );
  52 while ( @pairs ) {
  53         my $from  = shift @pairs;
  54         my $to    = shift @pairs;
  55         my $doc   = PPI::Document->new( \"( $from => 1 );" );
  56         isa_ok( $doc, 'PPI::Document' );
  57         my $word = $doc->find_first('Token::DashedWord');
  58         SKIP: {
  59                 skip( "PPI::Token::DashedWord is deactivated", 2 );
  60                 isa_ok( $word, 'PPI::Token::DashedWord' );
  61                 is( $word && $word->literal, $to, "The source $from becomes $to ok" );
  62         }
  63 }
  64
  65 =end testing
  66
  67 =cut
  68
  69 *literal = *PPI::Token::Word::literal;
  70
  71
  72
  73 #####################################################################
  74 # Tokenizer Methods
  75
  76 sub __TOKENIZER__on_char {
  77         my $t = $_[1];
  78
  79         # Suck to the end of the dashed bareword
  80         my $line = substr( $t->{line}, $t->{line_cursor} );
  81         if ( $line =~ /^(\w+)/ ) {
  82                 $t->{token}->{content} .= $1;
  83                 $t->{line_cursor} += length $1;
  84         }
  85
  86         # Are we a file test operator?
  87         if ( $t->{token}->{content} =~ /^\-[rwxoRWXOezsfdlpSbctugkTBMAC]$/ ) {
  88                 # File test operator
  89                 $t->{class} = $t->{token}->set_class( 'Operator' );
  90         } else {
  91                 # No, normal dashed bareword
  92                 $t->{class} = $t->{token}->set_class( 'Word' );
  93         }
  94
  95         $t->_finalize_token->__TOKENIZER__on_char( $t );
  96 }
  97
  98 1;
  99
 100 =pod
 101
 102 =head1 SUPPORT
 103
 104 See the L<support section|PPI/SUPPORT> in the main module.
 105
 106 =head1 AUTHOR
 107
 108 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 109
 110 =head1 COPYRIGHT
 111
 112 Copyright 2001 - 2009 Adam Kennedy.
 113
 114 This program is free software; you can redistribute
 115 it and/or modify it under the same terms as Perl itself.
 116
 117 The full text of the license can be found in the
 118 LICENSE file included with this module.
 119
 120 =cut