package Roman;
use strict;

# $Id: Roman.pm.noarch,v 1.3 2004/01/06 20:57:24 mrodrigu Exp $

=head1 NAME

Roman - Perl module for conversion between Roman and Arabic numerals.

=head1 SYNOPSIS

  use Roman;

  $arabic = arabic($roman) if isroman($roman);
  $roman = Roman($arabic);
  $roman = roman($arabic);

=head1 DESCRIPTION

This package provides some functions which help conversion of numeric
notation between Roman and Arabic.

=head1 BUGS

Domain of valid Roman numerals is limited to less than 40000, using
Unicode characters for numbers above 4000 (needs 5.8.0 or above).

=head1 AUTHOR

OZAWA Sakuro <ozawa@aisoft.co.jp>
Updated for Unicode support by Michel Rodriguez <mirod@cpan.org>

=head1 COPYRIGHT

Copyright (c) 1995 OZAWA Sakuro.  All rights reserved.  This program
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.

Additional code Copyright (c) 2003 Michel Rodriguez. All rights reserved.
This program is free software; you can redistribute it and/or modify it 
under the same terms as Perl itself.


=cut


use vars qw($VERSION @ISA @EXPORT);

$VERSION="1.3";

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(isroman arabic Roman roman);

my( %roman2arabic, %roman_digit, @figure, $K5, $K10, $highest_digit);

BEGIN {
    $K5=  "\x{2181}";      # digit for 5000               # 5.8
    $K10= "\x{2182}";      # digit for 10000              # 5.8
#
    $highest_digit= 10000; # could be computed I suppose  # 5.8
    %roman2arabic = ( I => 1,
                      V => 5,
                      X    => 10,
                      L    => 50,
                      C    => 100,
                      D    => 500,
                      M    => 1000,
                      $K5  => 5000,                       # 5.8
                      $K10 => 10000                       # 5.8
                    );
}

sub isroman {
    my($arg) = shift;
    $arg ne '' and
      $arg =~ /^
                (?: $K10{0,3})                            # 5.8
                (?: $K5 ?M{0,3} | M[$K5$K10])             # 5.8
#
                (?: D?C{0,3} | C[DM])
                (?: L?X{0,3} | X[LC])
                (?: V?I{0,3} | I[VX])$/ix;
}

sub arabic {
    my($arg) = shift;
    isroman $arg or return undef;
    my($arabic);
    my $last_digit= $highest_digit;
    foreach (split(//, uc $arg)) {
        my($digit) = $roman2arabic{$_};
        $arabic -= 2 * $last_digit if $last_digit < $digit;
        $arabic += ($last_digit = $digit);
    }
    return $arabic;
}

BEGIN {
#
    %roman_digit = (1 => "IV", 10 => "XL", 100 => "CD", 1000 => "M$K5", 10000 => "$K10"x4 ); # 5.8
    @figure = reverse sort keys %roman_digit;
    grep($roman_digit{$_} = [split(//, $roman_digit{$_}, 2)], @figure);
}

sub Roman {
    my($arg) = shift;
    (0 < $arg) and ($arg < (4 * $highest_digit)) or return undef;
    my($x, $roman);
    foreach (@figure) {
        my($digit, $i, $v) = (int($arg / $_), @{$roman_digit{$_}});
        if (1 <= $digit and $digit <= 3) {
            $roman .= $i x $digit;
        } elsif ($digit == 4) {
            $roman .= "$i$v";
        } elsif ($digit == 5) {
            $roman .= $v;
        } elsif (6 <= $digit and $digit <= 8) {
            $roman .= $v . $i x ($digit - 5);
        } elsif ($digit == 9) {
            $roman .= "$i$x";
        }
        $arg -= $digit * $_;
        $x = $i;
    }
    return $roman;
}

sub roman {
    return lc Roman shift;
}

1;
