blob: f18215e4f0539a46e467d8241593db10fd0bcefa (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/ say /;
# Usage, e.g.
# ./ch-2.pl -to-base35 123
# ./ch-2.pl -from-base35 ABCD
my %args = @ARGV;
my @charset = ( 0..9, 'A'..'Y' );
my $base = @charset;
say to_base35( $args{'-to-base35'} ) if $args{'-to-base35'};
say from_base35( $args{'-from-base35'} ) if $args{'-from-base35'};
sub from_base35 {
my ( $base35 ) = @_;
my $sign = $base35 =~ s/-//g ? '-' : '';
my @digits = split '', $base35;
my $idx = join '', @charset;
my $pos = 0;
my $val;
while ( my $char = pop @digits ) {
$val += index( $idx, $char ) * ( $base ** $pos );
$pos++;
}
$sign . $val;
}
sub to_base35 {
my ( $int ) = @_;
my $sign = ( $int < 0 ) ? '-' : '';
my @digits;
$int = abs( $int );
do {
push @digits, $charset[ $int % $base ];
$int = int( $int / $base );
} while ( $int > 0 );
$sign . join '', reverse @digits;
}
|
