Zahlensysteme umwandeln in perl

Angeregt durch eine Diskussion mit einem Kollegen vor einiger Zeit, und jetzt nochmal in einem Facebook-Kommentar, habe ich ein kleines Perl-Skript geschrieben, mit dem man Zahlen von einem Zahlensystem in ein anderes umrechnen kann.

Dabei können sowohl Ausgangs- als auch Zielsystem beliebige Basis haben, man muss beim Aufruf angeben, von wo nach wo umgewandelt werden soll. Im Moment funktioniert es nur bis Basis 16. Wer größere Werte braucht, findet leicht die eine Stelle im Code, die geändert werden muss ;). In Vorlesungsskripten steht dann üblicherweise " ... left as an exercise for the reader".

Als kleines Bonbon ist es auch möglich, nicht nur die Zahlen auszugeben, sondern alternativ auch die ASCII-Zeichen, die diesen Werten entsprechen.

Damit kann man dann lustige, leicht unverständliche Kommentare schreiben wie

> 1000010 1101001 1101110 1100001 1100101 1110010 1100011 1101111 1100100 1100101 1101001 1110011 1110100 1100110 1110101 1100101 1110010 1010111 1100101 1101001 1100011 1101000 1100101 1101001 1100101 1110010 100001

>  01001110 01101001 01111000 00100000 01100100 01100001 00101100 00100000 01001000 01100101 01111000 00100000 01101001 01110011 01110100 00100000 01100110 11000011 10111100 01110010 00100000 01000110 01100001 01110101 01101100 01100101 01101110 01111010 01100101 01110010 00100001

 >  53 65 6c 62 73 74 76 65 72 73 74 61 65 6e 64 6c 69 63 68 2c 50 72 6f 67 72 61 6d 6d 69 65 72 65 72 73 69 6e 64 66 61 75 6c 3b 2d 29

So wird es benutzt:

$ ./code.pl -i16 -o2 48 61 6c 6c 6f
# out: 1001000 1100001 1101100 1101100 1101111

$ ./code.pl -a -i16 -o2 48 61 6c 6c 6f
# asc: Hallo

$ ./code.pl -a -i2 -o16 01101000 01100001 00100000 01101000 01100001
# asc: ha ha

$ ./code.pl -i10 -o2 1 2 3 4 5
# out: 1 10 11 100 101

#!/usr/bin/perl -w

use strict 'vars';
use strict 'refs';

use Getopt::Std;

use vars qw($opt_i $opt_o $opt_a $opt_v);

my ($in,$out,$inbase,$outbase,$ok);
my $chars="0123456789abcdef";

sub from {
    my $v=0;
    if ($inbase==1) {
        $v=ord($_[0]);
    }
    else {
        print "# c: " if ($opt_v);
        for my $c (split(//,$_[0])) {
            print ".$c" if ($opt_v);
            my $t=index($chars,lc($c));
            $v=($v*$inbase)+$t;
        }
        print " ($v)\n" if ($opt_v);
    }
    return $v;
}

sub to {
    my $c="";
    if ($outbase==1) {
        $c=chr($_[0]);
        print ".$c" if ($opt_v);
    }
    else {
        my $v=$_[0];
        while ($v>0) {
            my $t=$v%$outbase;
            $c=substr($chars,$t,1).$c;
            $v=int($v/$outbase);
            print ".$v%$t" if ($opt_v);
        }
        print " ($c)\n" if ($opt_v);
        $c=" ".$c;
    }
    return $c;
}

getopts("avi:o:");
$ok=0;
my $asc="";

if ($opt_i) { $inbase =$opt_i; $ok|=1; }
if ($opt_o) { $outbase=$opt_o; $ok|=2; }
if ($ok!=3) {
    print STDERR "# unknown base!\n";
    exit(1);
}

if ($#ARGV>=0) { $in=join(" ",@ARGV); }
else { $in=<>; }

print "# from: $inbase\n"  if ($opt_v);
print "# to  : $outbase\n" if ($opt_v);

if ($inbase==1) {
    $in=join(" ",split(//,$in));
}
foreach my $word (split(/\s+/,$in)) {
    my ($c,$a);

    print "# w: $word\n" if ($opt_v);
    $c=from($word);
    print "# c: $c\n" if ($opt_v);
    $a=to($c);
    $asc.=chr($c);
    $out.=$a;
}

print "# out:$out\n" unless ($opt_a);
print "# asc: $asc\n" if ($opt_a);