to_roman.pl

#!/usr/bin/perl

use Carp qw(croak);
use 5.010;
use Test::Simple tests => 6;

use strict;
use warnings;

sub to_roman {
    my ($val) = shift;
    return '' if $val <= 0;
    croak 'values larger than 3999 not supported' if ($val >= 4000);
    
    my ($th, $h, $t) = (0, 0, 0);
    if ($val >= 1000) {
        $th = int $val / 1000;
        $val -= 1000*$th;
    }

    if ($val >= 100) { 
        $h = int $val / 100;
        $val -= 100*$h;  
    }

    if ($val >= 10) {
        $t = int $val / 10;
        $val -= 10*$t;
    }

    my %rel = (
        0 => ['C', 'D', 'M'],
        1 => ['X', 'L', 'C'],
        2 => ['I', 'V', 'X'] 
    );

    my $res = 'M' x $th;

    my $index = 0;
    foreach my $count ($h, $t, $val) {
        my ($ch, $ch_next, $ch_next_next) = @{$rel{$index}};
        $res .= ($count <= 3 ? $ch x $count 
                 : $count == 4 ? $ch . $ch_next 
                 : $count == 5 ? $ch_next 
                 : $count <= 8 ? $ch_next . ($ch x ($count-5)) 
                 : $ch . $ch_next_next);             
        
        ++$index;
    }

    return $res;
}

ok( to_roman(0) eq "", '0 is an empty string');
ok( to_roman(3) eq "III", '3 is "III"');
ok( to_roman(100)  eq 'C', '100 is "C"');
ok( to_roman(99)  eq 'XCIX', '99 is "XCIX"');
ok( to_roman(2424) eq 'MMCDXXIV', '2494 is "MMCDXXIV"');
ok( to_roman(418) eq 'CDXVIII', '418 is "CDXCVIII"');