File Coverage

blib/lib/PPI/Token/Number/Octal.pm
Criterion Covered Total %
statement 22 22 100.0
branch 9 10 90.0
condition 3 3 100.0
subroutine 4 4 100.0
pod 1 1 100.0
total 39 40 97.5


line stmt bran cond sub pod time code
1             package PPI::Token::Number::Octal;
2              
3             =pod
4              
5             =head1 NAME
6              
7             PPI::Token::Number::Octal - Token class for a binary number
8              
9             =head1 SYNOPSIS
10              
11             $n = 0777; # octal integer
12              
13             =head1 INHERITANCE
14              
15             PPI::Token::Number::Octal
16             isa PPI::Token::Number
17             isa PPI::Token
18             isa PPI::Element
19              
20             =head1 DESCRIPTION
21              
22             The C<PPI::Token::Number::Octal> class is used for tokens that
23             represent base-8 numbers.
24              
25             =head1 METHODS
26              
27             =cut
28              
29 67     67   338 use strict;
  67         130  
  67         1833  
30 67     67   227 use PPI::Token::Number ();
  67         104  
  67         17254  
31              
32             our $VERSION = '1.284';
33              
34             our @ISA = "PPI::Token::Number";
35              
36             =pod
37              
38             =head2 base
39              
40             Returns the base for the number: 8.
41              
42             =cut
43              
44             sub base() { 8 }
45              
46             =pod
47              
48             =head2 literal
49              
50             Return the numeric value of this token.
51              
52             =cut
53              
54             sub literal {
55 10     10 1 105 my $self = shift;
56 10 100       72 return if $self->{_error};
57 6         25 my $str = $self->_literal;
58             # oct supports '0o' notation only since 5.34
59 6         25 $str =~ s (^0[oO]) (0);
60 6         13 my $neg = $str =~ s/^\-//;
61 6         18 my $val = oct $str;
62 6 50       31 return $neg ? -$val : $val;
63             }
64              
65              
66              
67              
68              
69             #####################################################################
70             # Tokenizer Methods
71              
72             sub __TOKENIZER__on_char {
73 52     52   93 my $class = shift;
74 52         97 my $t = shift;
75 52         118 my $char = substr( $t->{line}, $t->{line_cursor}, 1 );
76              
77             # Allow underscores straight through
78 52 100       121 return 1 if $char eq '_';
79              
80 51 100       126 if ( $char =~ /\d/ ) {
81             # You cannot have 8s and 9s on octals
82 15 100 100     56 if ( $char eq '8' or $char eq '9' ) {
83 5         14 $t->{token}->{_error} = "Illegal character in octal number '$char'";
84             }
85 15         39 return 1;
86             }
87              
88             # Doesn't fit a special case, or is after the end of the token
89             # End of token.
90 36         77 $t->_finalize_token->__TOKENIZER__on_char( $t );
91             }
92              
93             1;
94              
95             =pod
96              
97             =head1 SUPPORT
98              
99             See the L<support section|PPI/SUPPORT> in the main module.
100              
101             =head1 AUTHOR
102              
103             Chris Dolan E<lt>cdolan@cpan.orgE<gt>
104              
105             =head1 COPYRIGHT
106              
107             Copyright 2006 Chris Dolan.
108              
109             This program is free software; you can redistribute
110             it and/or modify it under the same terms as Perl itself.
111              
112             The full text of the license can be found in the
113             LICENSE file included with this module.
114              
115             =cut