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<PPI::Token::Number> 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 67     67   328 use strict;
  67         112  
  67         1856  
33 67     67   223 use PPI::Token ();
  67         86  
  67         28418  
34              
35             our $VERSION = '1.284';
36              
37             our @ISA = "PPI::Token";
38              
39             =pod
40              
41             =head2 base
42              
43             The C<base> 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 8     8 1 134 return 0 + $_[0]->_literal;
60             }
61              
62             sub _literal {
63             # De-sugar the string representation
64 80     80   123 my $self = shift;
65 80         258 my $string = $self->content;
66 80         191 $string =~ s/^\+//;
67 80         255 $string =~ s/_//g;
68 80         250 return $string;
69             }
70              
71              
72              
73              
74              
75             #####################################################################
76             # Tokenizer Methods
77              
78             sub __TOKENIZER__on_char {
79 31551     31551   39573 my $class = shift;
80 31551         34309 my $t = shift;
81 31551         50243 my $char = substr( $t->{line}, $t->{line_cursor}, 1 );
82              
83             # Allow underscores straight through
84 31551 100       50199 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 31145         37758 my $token = $t->{token};
89 31145 100       75980 if ( $token->{content} =~ /^-?0_*$/ ) {
90             # This could be special
91 2977 100 100     26966 if ( $char eq 'x' || $char eq 'X' ) {
    100 100        
    100 100        
    100          
92 46         164 $t->{class} = $t->{token}->set_class( 'Number::Hex' );
93 46         141 return 1;
94             } elsif ( $char eq 'b' || $char eq 'B' ) {
95 28         91 $t->{class} = $t->{token}->set_class( 'Number::Binary' );
96 28         93 return 1;
97             } elsif ( $char eq 'o' || $char eq 'O' ) {
98 2         8 $t->{class} = $t->{token}->set_class( 'Number::Octal' );
99 2         7 return 1;
100             } elsif ( $char =~ /\d/ ) {
101             # You cannot have 8s and 9s on octals
102 34 100 100     194 if ( $char eq '8' or $char eq '9' ) {
103 12         36 $token->{_error} = "Illegal character in octal number '$char'";
104             }
105 34         111 $t->{class} = $t->{token}->set_class( 'Number::Octal' );
106 34         86 return 1;
107             }
108             }
109              
110             # Handle the easy case, integer or real.
111 31035 100       81966 return 1 if $char =~ /\d/o;
112              
113 18356 100       33025 if ( $char eq '.' ) {
114 2453         7581 $t->{class} = $t->{token}->set_class( 'Number::Float' );
115 2453         6206 return 1;
116             }
117 15903 100 100     50512 if ( $char eq 'e' || $char eq 'E' ) {
118 13         48 $t->{class} = $t->{token}->set_class( 'Number::Exp' );
119 13         36 return 1;
120             }
121              
122             # Doesn't fit a special case, or is after the end of the token
123             # End of token.
124 15890         27181 $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<support section|PPI/SUPPORT> in the main module.
151              
152             =head1 AUTHOR
153              
154             Adam Kennedy E<lt>adamk@cpan.orgE<gt>
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