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 67     67   462 use strict;
  67         189  
  67         2414  
33 67     67   358 use PPI::Token ();
  67         119  
  67         39981  
34              
35             our $VERSION = '1.28401'; # TRIAL
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 110 return 0 + $_[0]->_literal;
60             }
61              
62             sub _literal {
63             # De-sugar the string representation
64 77     77   202 my $self = shift;
65 77         291 my $string = $self->content;
66 77         220 $string =~ s/^\+//;
67 77         208 $string =~ s/_//g;
68 77         292 return $string;
69             }
70              
71              
72              
73              
74              
75             #####################################################################
76             # Tokenizer Methods
77              
78             sub __TOKENIZER__on_char {
79 31651     31651   56990 my $class = shift;
80 31651         55335 my $t = shift;
81 31651         83115 my $char = substr( $t->{line}, $t->{line_cursor}, 1 );
82              
83             # Allow underscores straight through
84 31651 100       85696 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 31241         59454 my $token = $t->{token};
89 31241 100       143983 if ( $token->{content} =~ /^-?0_*$/ ) {
90             # This could be special
91 3001 100 100     39805 if ( $char eq 'x' || $char eq 'X' ) {
    100 100        
    100 100        
    100          
92 47         217 $t->{class} = $t->{token}->set_class( 'Number::Hex' );
93 47         235 return 1;
94             } elsif ( $char eq 'b' || $char eq 'B' ) {
95 23         126 $t->{class} = $t->{token}->set_class( 'Number::Binary' );
96 23         101 return 1;
97             } elsif ( $char eq 'o' || $char eq 'O' ) {
98 2         9 $t->{class} = $t->{token}->set_class( 'Number::Octal' );
99 2         11 return 1;
100             } elsif ( $char =~ /\d/ ) {
101             # You cannot have 8s and 9s on octals
102 44 100 100     308 if ( $char eq '8' or $char eq '9' ) {
103 19         79 $token->{_error} = "Illegal character in octal number '$char'";
104             }
105 44         197 $t->{class} = $t->{token}->set_class( 'Number::Octal' );
106 44         218 return 1;
107             }
108             }
109              
110             # Handle the easy case, integer or real.
111 31125 100       134175 return 1 if $char =~ /\d/o;
112              
113 18439 100       51504 if ( $char eq '.' ) {
114 2448         10498 $t->{class} = $t->{token}->set_class( 'Number::Float' );
115 2448         9427 return 1;
116             }
117 15991 100 100     82901 if ( $char eq 'e' || $char eq 'E' ) {
118 13         49 $t->{class} = $t->{token}->set_class( 'Number::Exp' );
119 13         52 return 1;
120             }
121              
122             # Doesn't fit a special case, or is after the end of the token
123             # End of token.
124 15978         49844 $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