sub jcwren {
  my $num = shift;
  my($ok, $base, $value);
  if($num =~ m/^0x([\dA-Fa-f]+)$/s or $num =~ m/^([\dA-Fa-f]+)h$/s) {
    $ok = 1; $base = 16; $value = hex($1);
  }
  elsif($num =~ m/^([0-7]+)o$/s) {
    $ok = 1; $base = 8; $value = oct($1);
  }
  elsif($num =~ m/^([+-]?(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?
+)t?$/s) {
    $ok = 1; $base = 10; $value = 0 + $1;
  }
  else {
    $ok = 0; $base = 0; $value = 0;
  }
  return($ok, $base, $value);
}
[download]

sub isNumber {
    local( $_ )= @_;
    my( $ok, $val, $base );
    if(  s/h$//i  &&  s/^/0x/
     ||  m/^0x/  ) {
        $ok= m/^0x[\da-f]+$/i;
        $val= hex($_);
        $base= 16;
    } elsif(  s/o$//i  ) {
        $ok= m/^[0-7]+$/;
        $val= oct($_);
        $base= 8;
    } else {
        my $warn;
        local( $SIG{__WARN__} )= sub {
            $warn= $_[0];
        };
        local( $^W )= 1;
        $val= 0 + $_;
        $ok= ! $warn;
        $base= 10;
    }
    $_[1]= $val;
    $_[2]= $base;
    return $ok;
}
my $num= <STDIN>;
my $val;
if(  isNumber( $num, $val, $base )   ) {
    print "Your number's value is $val in base $base.\n";
} else {
    print "Your number is invalid but might be close to $val in base $
+base.\n";
}
[download]

Note that I didn't treat a leading zero as octal and I'm a bit inconsistant with how much whitespace I'll ignore.

Updated: To return the base.

My first pass at this seems to work okay, though I should probably add a few more tests. Though I have regexes to specify formats, I tried to make it fairly simple to maintain, in case specifications change. There's a test at the top of the code. Just add numbers you want to test to the array to see if they pass or fail.

#!/usr/bin/perl -w
use strict;
use Data::Dumper;

my @nums = qw/ 0xff 09h 123.25 14E+12 0xfffa 0xffffh 123.25t 777o 123.
+23.45 1.2e+13 /;

foreach ( @nums ) {
    my $result = convert_num( $_ );
    if ( $result->{ valid } ) {
        print "$_ is a $result->{base} number with a $result->{value} 
+decimal value.\n";
    } else {
        print "$_ is not a valid number.\n";
    } 
}

sub convert_num {
    my $num = shift;
    
    my %bases = (
        hex        => {
            description => [ qw/ ^0x[A-Fa-f0-9]+$ ^[A-Fa-f0-9]+h$ / ],
            function    => sub { ( $_[0] ) = ( $_[0] =~ /(?:0x)?([a-fA
+-F0-9]+)/ ); hex( $_[0] ) }
        },
        octal      => {
            description => [ '^[0-7]+o$' ],
            function    => sub { ( $_[0] ) = ( $_[0] =~ /([0-7]+)/ ); 
+oct( $_[0] ) }
        },
        decimal    => {
            description => [ qw/  ^\d*\.\d+(?!\.)\d*t?$ / ],
            function    => sub { $_[0] =~ s/t$//; $_[0] }
        },
        scientific => {
            description => [ '^\d*\.?\d+(?!\.)\d*[Ee]\+\d+$' ],
            function    => sub { 1 * shift }
        }
    );

    my %result = ( 
        valid => 0,
        base => '',
        value => $num
    ) ;
    
    foreach my $base ( keys %bases ) {
        foreach my $regex ( @{ $bases{$base}{description} } ) {
            if ( $num =~ /$regex/ ) {
                $result{ valid }++;
                $result{ base } = $base;
            }
        }
    }    
    if ( $result{ valid } != 1 ) {
        @result{ qw/ valid base value / } = ('','','');
    } else {
        my $function = $bases{ $result{ base } }{ function };
        $result{ value } = $function->( $num );
    }
    return \%result;
}
[download]

To be perfectly fair, the scientific notation regex is a bit of a hack and needs to be fixed.

The code works by checking whether the argument to the sub is valid for one of the regexes specified in the %bases hash. If it's valid for more than one type, then the argument is considered ambiguous.

Cheers,
Ovid

Update: Looking at MrNobo1024's code and it seems like I overcoded the heck out of this.

Vote for paco!

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

my $str = "123e4";
print asNum( $str );
sub asNum {
  my $str = shift;
  my $foo;
  eval "\$foo = $str"; # backslash for string not reference
  if( $@ ) {
    warn( "oops : $@" );
  }
  return $str;
}
[download]

That should be return $foo - this won't deal with several of the specified cases like h and t suffixes but it is clever nonetheless :-)

cheers

tachyon

s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

I'm sure I'm going to get downvoted for this, but hey, it's my opinion, and it's not like I'm really going to lose much sleep over XP.

Congratulations to the last person who voted this simple request down. I've had it with the trolls, votebots, and general decline of civilization of PM. I'm outta here.

jcwren, your node has a reputation of 109. That's quite a lot. I mean, it's higher than most people's nodes have ever reached, certainly mine. Why are you getting so upset over people downvoting you? That's their opinion, and they're allowed it. It's what the whole freedom of speech thing in the US constitution is about - people disagreeing with others, and being allowed to do so. If people vote your node down, it's because they think you deserve -- XP, and that's their choice. Why can't you just accept that, and move on in life? There's no mechanism in perlmonks for people to say why they downvoted, so you'll never know why people did (unless they own up), but does it really matter? Why do you care so much?

Remember, mischief ... www.perlmonks.org is available to ANY other country that has internet access, and software to view this site ... It's what the whole freedom of speech thing in the US constituion is about ... some people aren't from the US ... does the constitution apply to them as well?

Beside the point, what's the big deal over XP? I know, I used to care about my XP when I first came to the Monastery, and was in awe of nodes of 50 XP or higher :-) but, it really doesn't matter how high or how low you get your XP on various nodes... it's content,content,content ... (or at least it should be.)

Of course this is just my own free speech ;-) ...

Andy Summers

I didn't mean to say that the actual constitution applied to this, only to say that the principle of free speech means that it's someone's right to disagree and voice their opinions - in this case, by voting a post down. (By the way, I live in Prague, the Czech Republic. :-)

Congratulations to the last person who voted this simple request down. I've had it with the trolls, votebots, and general decline of civilization of PM. I'm outta here.

I downvoted this node on general principle as soon as i read those lines. Then i was extremely surprised to see the rep of the node at 109. Granted, you (jcwren) have been a reg for the year and a half that i've been coming around here, and you've written some amazing code. But posting a question asking someone else to write code based on an elaborate spec of your own design is not (in my opinion) a node that deserves a reputation this high. i'm sure this node would have been downvoted into oblivion except for the following:

<l>

So i downvoted you just because I can. Which may be childish, but who cares? xp are imaginary points that are redeemable for nothing; what does it matter if your xp goes from 7002 to 7001?

BlueLines

Disclaimer: This post may contain inaccurate information, be habit forming, cause atomic warfare between peaceful countries, speed up male pattern baldness, interfere with your cable reception, exile you from certain third world countries, ruin your marriage, and generally spoil your day. No batteries included, no strings attached, your mileage may vary.