local-lib5/lib/perl5/PPI/Token/Number/Binary.pm

   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<PPI::Token::Number::Binary> class is used for tokens that
  23 represent base-2 numbers.
  24
  25 =head1 METHODS
  26
  27 =cut
  28
  29 use strict;
  30 use PPI::Token::Number ();
  31
  32 use vars qw{$VERSION @ISA};
  33 BEGIN {
  34         $VERSION = '1.206';
  35         @ISA     = 'PPI::Token::Number';
  36 }
  37
  38 =pod
  39
  40 =head2 base
  41
  42 Returns the base for the number: 2.
  43
  44 =cut
  45
  46 sub base {
  47         return 2;
  48 }
  49
  50 =pod
  51
  52 =head2 literal
  53
  54 Return the numeric value of this token.
  55
  56 =cut
  57
  58 sub literal {
  59         my $self = shift;
  60         return if $self->{_error};
  61         my $str = $self->_literal;
  62         my $neg = $str =~ s/^\-//;
  63         $str =~ s/^0b//;
  64         my $val = 0;
  65         for my $bit ( $str =~ m/(.)/g ) {
  66                 $val = $val * 2 + $bit;
  67         }
  68         return $neg ? -$val : $val;
  69 }
  70
  71
  72
  73
  74
  75 #####################################################################
  76 # Tokenizer Methods
  77
  78 sub __TOKENIZER__on_char {
  79         my $class = shift;
  80         my $t     = shift;
  81         my $char  = substr( $t->{line}, $t->{line_cursor}, 1 );
  82
  83         # Allow underscores straight through
  84         return 1 if $char eq '_';
  85
  86         if ( $char =~ /[\w\d]/ ) {
  87                 unless ( $char eq '1' or $char eq '0' ) {
  88                         # Add a warning if it contains non-hex chars
  89                         $t->{token}->{_error} = "Illegal character in binary number '$char'";
  90                 }
  91                 return 1;
  92         }
  93
  94         # Doesn't fit a special case, or is after the end of the token
  95         # End of token.
  96         $t->_finalize_token->__TOKENIZER__on_char( $t );
  97 }
  98
  99 1;
 100
 101 =pod
 102
 103 =head1 SUPPORT
 104
 105 See the L<support section|PPI/SUPPORT> in the main module.
 106
 107 =head1 AUTHOR
 108
 109 Chris Dolan E<lt>cdolan@cpan.orgE<gt>
 110
 111 =head1 COPYRIGHT
 112
 113 Copyright 2006 Chris Dolan.
 114
 115 This program is free software; you can redistribute
 116 it and/or modify it under the same terms as Perl itself.
 117
 118 The full text of the license can be found in the
 119 LICENSE file included with this module.
 120
 121 =cut