examples/perl/toroman.plPerl
#!/usr/bin/perl

use warnings;

sub toRomanHelper($$)
{
	my $n=shift;
	my $d=shift;

	my $i=qw/I X C M/[$d];
	my $v=qw/V L D/[$d];
	my $x=qw/X C M/[$d];

	return $i x $n if $n>=0 and $n<=3;
	return ($i x (5-$n)).$v if $n==4;
	return $v.($i x ($n-5)) if $n>=5 and $n<=8;
	return $i.$x;
}

sub toRoman($)
{
	my $n=shift;
	return if $n!~m/^\d+$/ or $n>=4000;

	my $roman='';
	for(my $d=0; $n; $n=int($n/10))
	{
		$roman=toRomanHelper($n % 10, $d++).$roman;
	}
	return $roman;
}

##################################################

die "$0: Требуется натуральное число от 1 до 3999\n"
	unless defined(my $decimal=shift);
die "$0: Неправильное число: «$decimal»\n"
	unless defined(my $roman=toRoman($decimal));

print "$roman\n";

examples/perl/parseroman.plPerl
#!/usr/bin/perl

use warnings;

sub parseRomanHelper($$)
{
	my $fragment=shift;
	return 0 unless $fragment;
	my $d=shift;

	if($d==1)
	{
		$fragment=~tr/XLC/IVX/;
	}
	elsif($d==2)
	{
		$fragment=~tr/CDM/IVX/;
	}
	elsif($d==3)
	{
		$fragment=~tr/M/I/;
	}

	$d=10**$d;
	return $d*length($fragment) if $fragment=~m/^I{1,3}$/;
	return $d*4 if $fragment eq 'IV';
	return $d*(4+length($fragment)) if $fragment=~m/^VI{0,3}$/;
	return $d*9;
}

sub parseRoman($)
{
	if(shift=~m/^(M{0,3})(D?C{0,3}|C[DM])(L?X{0,3}|X[LC])(V?I{0,3}|I[VX])$/)
	{
		return parseRomanHelper($1, 3)
			+parseRomanHelper($2, 2)
			+parseRomanHelper($3, 1)
			+parseRomanHelper($4, 0);
	}
	return;
}

##################################################

die "$0: Требуется римское число\n"
	unless defined(my $roman=shift);
die "$0: Неправильное римское число: «$roman»\n"
	unless defined(my $decimal=parseRoman($roman));

print "$decimal\n";