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   371 use strict;
  69         97  
  69         1907  
33 69     69   241 use PPI::Token ();
  69         105  
  69         28702  
34              
35             our $VERSION = '1.291';
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 100 return 0 + $_[0]->_literal;
60             }
61              
62             sub _literal {
63             # De-sugar the string representation
64 77     77   91 my $self = shift;
65 77         213 my $string = $self->content;
66 77         156 $string =~ s/^\+//;
67 77         201 $string =~ s/_//g;
68 77         216 return $string;
69             }
70              
71              
72              
73              
74              
75             #####################################################################
76             # Tokenizer Methods
77              
78             sub __TOKENIZER__on_char {
79 110383     110383   117801 my $class = shift;
80 110383         103345 my $t = shift;
81 110383         152670 my $char = substr( $t->{line}, $t->{line_cursor}, 1 );
82              
83             # Allow underscores straight through
84 110383 100       157857 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 109979         121304 my $token = $t->{token};
89 109979 100       213594 if ( $token->{content} =~ /^-?0_*$/ ) {
90             # This could be special
91 3001 100 100     24370 if ( $char eq 'x' || $char eq 'X' ) {
    100 100        
    100 100        
    100          
92 54         155 $t->{class} = $t->{token}->set_class( 'Number::Hex' );
93 54         146 return 1;
94             } elsif ( $char eq 'b' || $char eq 'B' ) {
95 27         85 $t->{class} = $t->{token}->set_class( 'Number::Binary' );
96 27         67 return 1;
97             } elsif ( $char eq 'o' || $char eq 'O' ) {
98 2         7 $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 40 100 100     209 if ( $char eq '8' or $char eq '9' ) {
103 21         60 $token->{_error} = "Illegal character in octal number '$char'";
104             }
105 40         112 $t->{class} = $t->{token}->set_class( 'Number::Octal' );
106 40         106 return 1;
107             }
108             }
109              
110             # Handle the easy case, integer or real.
111 109856 100       247917 return 1 if $char =~ /\d/o;
112              
113 71534 100       100455 if ( $char eq '.' ) {
114 2467         7185 $t->{class} = $t->{token}->set_class( 'Number::Float' );
115 2467         6111 return 1;
116             }
117 69067 100 100     161413 if ( $char eq 'e' || $char eq 'E' ) {
118 13         34 $t->{class} = $t->{token}->set_class( 'Number::Exp' );
119 13         33 return 1;
120             }
121              
122             # Doesn't fit a special case, or is after the end of the token
123             # End of token.
124 69054         109005 $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