File Coverage

blib/lib/PPI/Token/Number.pm
Criterion Covered Total %
statement 37 37 100.0
branch 20 20 100.0
condition 15 15 100.0
subroutine 5 5 100.0
pod 1 1 100.0
total 78 78 100.0


line stmt bran cond sub pod time code
1             package PPI::Token::Number;
2              
3             =pod
4              
5             =head1 NAME
6              
7             PPI::Token::Number - Token class for a number
8              
9             =head1 SYNOPSIS
10              
11             $n = 1234; # decimal integer
12             $n = 0b1110011; # binary integer
13             $n = 01234; # octal integer
14             $n = 0x1234; # hexadecimal integer
15             $n = 12.34e-56; # exponential notation ( currently not working )
16              
17             =head1 INHERITANCE
18              
19             PPI::Token::Number
20             isa PPI::Token
21             isa PPI::Element
22              
23             =head1 DESCRIPTION
24              
25             The C class is used for tokens that represent numbers,
26             in the various types that Perl supports.
27              
28             =head1 METHODS
29              
30             =cut
31              
32 68     68   340 use strict;
  68         96  
  68         1858  
33 68     68   249 use PPI::Token ();
  68         80  
  68         28311  
34              
35             our $VERSION = '1.287';
36              
37             our @ISA = "PPI::Token";
38              
39             =pod
40              
41             =head2 base
42              
43             The C method is provided by all of the ::Number subclasses.
44             This is 10 for decimal, 16 for hexadecimal, 2 for binary, etc.
45              
46             =cut
47              
48             sub base() { 10 }
49              
50             =pod
51              
52             =head2 literal
53              
54             Return the numeric value of this token.
55              
56             =cut
57              
58             sub literal {
59 5     5 1 80 return 0 + $_[0]->_literal;
60             }
61              
62             sub _literal {
63             # De-sugar the string representation
64 77     77   98 my $self = shift;
65 77         205 my $string = $self->content;
66 77         150 $string =~ s/^\+//;
67 77         150 $string =~ s/_//g;
68 77         212 return $string;
69             }
70              
71              
72              
73              
74              
75             #####################################################################
76             # Tokenizer Methods
77              
78             sub __TOKENIZER__on_char {
79 110372     110372   112877 my $class = shift;
80 110372         105155 my $t = shift;
81 110372         143495 my $char = substr( $t->{line}, $t->{line_cursor}, 1 );
82              
83             # Allow underscores straight through
84 110372 100       141631 return 1 if $char eq '_';
85              
86             # Handle the conversion from an unknown to known type.
87             # The regex covers "potential" hex/bin/octal number.
88 109966         109838 my $token = $t->{token};
89 109966 100       199054 if ( $token->{content} =~ /^-?0_*$/ ) {
90             # This could be special
91 3014 100 100     24243 if ( $char eq 'x' || $char eq 'X' ) {
    100 100        
    100 100        
    100          
92 50         143 $t->{class} = $t->{token}->set_class( 'Number::Hex' );
93 50         148 return 1;
94             } elsif ( $char eq 'b' || $char eq 'B' ) {
95 23         68 $t->{class} = $t->{token}->set_class( 'Number::Binary' );
96 23         68 return 1;
97             } elsif ( $char eq 'o' || $char eq 'O' ) {
98 2         7 $t->{class} = $t->{token}->set_class( 'Number::Octal' );
99 2         6 return 1;
100             } elsif ( $char =~ /\d/ ) {
101             # You cannot have 8s and 9s on octals
102 38 100 100     169 if ( $char eq '8' or $char eq '9' ) {
103 13         38 $token->{_error} = "Illegal character in octal number '$char'";
104             }
105 38         115 $t->{class} = $t->{token}->set_class( 'Number::Octal' );
106 38         111 return 1;
107             }
108             }
109              
110             # Handle the easy case, integer or real.
111 109853 100       228818 return 1 if $char =~ /\d/o;
112              
113 71535 100       96331 if ( $char eq '.' ) {
114 2462         6345 $t->{class} = $t->{token}->set_class( 'Number::Float' );
115 2462         6251 return 1;
116             }
117 69073 100 100     146854 if ( $char eq 'e' || $char eq 'E' ) {
118 13         33 $t->{class} = $t->{token}->set_class( 'Number::Exp' );
119 13         29 return 1;
120             }
121              
122             # Doesn't fit a special case, or is after the end of the token
123             # End of token.
124 69060         98189 $t->_finalize_token->__TOKENIZER__on_char( $t );
125             }
126              
127             1;
128              
129             =pod
130              
131             =head1 CAVEATS
132              
133             Compared to Perl, the number tokenizer is too liberal about allowing
134             underscores anywhere. For example, the following is a syntax error in
135             Perl, but is allowed in PPI:
136              
137             0_b10
138              
139             =head1 TO DO
140              
141             - Treat v-strings as binary strings or barewords, not as "base-256"
142             numbers
143              
144             - Break out decimal integers into their own subclass?
145              
146             - Implement literal()
147              
148             =head1 SUPPORT
149              
150             See the L in the main module.
151              
152             =head1 AUTHOR
153              
154             Adam Kennedy Eadamk@cpan.orgE
155              
156             =head1 COPYRIGHT
157              
158             Copyright 2001 - 2011 Adam Kennedy.
159              
160             This program is free software; you can redistribute
161             it and/or modify it under the same terms as Perl itself.
162              
163             The full text of the license can be found in the
164             LICENSE file included with this module.
165              
166             =cut