File Coverage

blib/lib/PPI/Token/Number/Binary.pm
Criterion Covered Total %
statement 24 24 100.0
branch 9 10 90.0
condition 3 3 100.0
subroutine 4 4 100.0
pod 1 1 100.0
total 41 42 97.6


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