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 69     69   337 use strict;
  69         90  
  69         1840  
33 69     69   226 use PPI::Token ();
  69         78  
  69         27868  
34              
35             our $VERSION = '1.290';
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 82 return 0 + $_[0]->_literal;
60             }
61              
62             sub _literal {
63             # De-sugar the string representation
64 77     77   92 my $self = shift;
65 77         229 my $string = $self->content;
66 77         148 $string =~ s/^\+//;
67 77         145 $string =~ s/_//g;
68 77         177 return $string;
69             }
70              
71              
72              
73              
74              
75             #####################################################################
76             # Tokenizer Methods
77              
78             sub __TOKENIZER__on_char {
79 110394     110394   113492 my $class = shift;
80 110394         101483 my $t = shift;
81 110394         144243 my $char = substr( $t->{line}, $t->{line_cursor}, 1 );
82              
83             # Allow underscores straight through
84 110394 100       147824 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 109991         114473 my $token = $t->{token};
89 109991 100       202687 if ( $token->{content} =~ /^-?0_*$/ ) {
90             # This could be special
91 3011 100 100     22532 if ( $char eq 'x' || $char eq 'X' ) {
    100 100        
    100 100        
    100          
92 52         150 $t->{class} = $t->{token}->set_class( 'Number::Hex' );
93 52         143 return 1;
94             } elsif ( $char eq 'b' || $char eq 'B' ) {
95 24         67 $t->{class} = $t->{token}->set_class( 'Number::Binary' );
96 24         60 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 29 100 100     113 if ( $char eq '8' or $char eq '9' ) {
103 10         29 $token->{_error} = "Illegal character in octal number '$char'";
104             }
105 29         89 $t->{class} = $t->{token}->set_class( 'Number::Octal' );
106 29         84 return 1;
107             }
108             }
109              
110             # Handle the easy case, integer or real.
111 109884 100       231810 return 1 if $char =~ /\d/o;
112              
113 71556 100       100681 if ( $char eq '.' ) {
114 2460         6200 $t->{class} = $t->{token}->set_class( 'Number::Float' );
115 2460         6130 return 1;
116             }
117 69096 100 100     155769 if ( $char eq 'e' || $char eq 'E' ) {
118 13         38 $t->{class} = $t->{token}->set_class( 'Number::Exp' );
119 13         32 return 1;
120             }
121              
122             # Doesn't fit a special case, or is after the end of the token
123             # End of token.
124 69083         100043 $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