—

              
package Convert::Number::Roman;
use utf8;  # can't find a way to conditionally load this with
           # the scope applying throughout
BEGIN
{
        use strict;
        use warnings;
        use vars qw($VERSION %RomanDigits);
        $VERSION = '0.02';
        require 5.000;
        %RomanDigits =(
                Ⅰ       => 1,
                Ⅱ       => 2,
                Ⅲ       => 3,
                Ⅳ       => 4,
                Ⅴ       => 5,
                Ⅵ       => 6,
                Ⅶ       => 7,
                Ⅷ       => 8,
                Ⅸ       => 9,
                Ⅹ       => 10,
                Ⅺ       => 11,
                Ⅻ       => 12,
                Ⅼ       => 50,
                Ⅽ       => 100,
                Ⅾ       => 500,
                Ⅿ       => 1000,
                ↁ       => 5000,
                ↂ       => 10000
        );
}
sub _setArgs
{
my ($self, $number, $style) = @_;
        if ( $#_ > 2 ) {
                warn (  "too many arguments." );
                return;
        }
        if ( $number =~ /lower|upper/ ) {
                $style  = $number;
                $number = undef;
        }
        if ( $number ) {
                unless ( $number =~ /^\d+$/ || $number =~ /^[̄̿Ⅰ-ↂ]+$/ ) {
                        warn (  "'$number' is not a number." );
                        return;
                }
                else {
                        $self->{number} = $number;
                }
        }
        if ( $style ) {
                if ( $style =~ /lower|upper/i ) {
                        $self->{style} = lc($style);
                }
                else {
                        warn (  "'$style' is not a supported style, using 'upper'." );
                }
        }
         
1;
}
sub new
{
my $class = shift;
my $self  = {};
        my $blessing = bless ( $self, $class );
        $self->{number} = undef;
        $self->{style}  = "upper";
        $self->_setArgs ( @_ ) || return if ( @_ );
        $blessing;
}
sub _fromRoman
{
        $_ = $_[0]->{number};
        #
        # convert to uppercase roman:
        #
        tr/ⅰ-ⅿ/Ⅰ-Ⅿ/;  # get on up!
        #
        # just return if its a single char:
        #
        return ( $RomanDigits{$_} ) if ( length($_) == 1);
        #
        # make into math:
        #
        # s/̿/̄̄/og;
        s/\x{033F}/\x{0304}/og;
        while ( /[Ⅰ-ↂ](̄+)/ ) {
                my $power = $1;
                my $group;
                s/([Ⅰ-ↂ])$power/$group .= $1; "$1$power";/eg;
                s/([Ⅰ-ↂ]$power)+/($group)*($power)/;
        }
        s/̄/*1000/og;
        s/Ⅿↂ/+9000/og;
        s/Ⅿↁ/+4000/og;
        s/ⅭⅯ/+900/og;
        s/ⅭⅮ/+400/og;
        s/ⅩⅭ/+90/og;
        s/ⅩⅬ/+40/og;
        s/([ↁⅮⅬ])/+$RomanDigits{$1}/og;
        s/([ↂⅯⅭⅩ])/+$RomanDigits{$1}/og;
        s/([Ⅰ-Ⅻ])/+$RomanDigits{$1}/og;
        s/\([+*]/(/g;
        s/\)\(/\)+\(/g;
        s/\(([\d+]+)\)/eval"$1"/eg;
        s/^\+//;
        #
        # evaluate the expression:
        #
        eval "$_";
}
sub _toRoman
{
my ($self, $number) = @_;
$number = $self->{number} unless ( defined($number) );
        $number =~ s/^0+//;  # strip leading zeros
        my $roman;
if ( $number >= 40000 ) {
        my $lines;
        while ( $number ) {
                $number =~ s/(\d{1,3})$//; 
                my $group = $1;
                if ( $group != /^0+$/ ) {
                        if ( $lines ) {
                                my $rGroup = $self->_toRoman ( $group );
                                $rGroup =~ s/(.)/$1$lines/g;
                                $roman = ( $roman ) ? "$rGroup$roman" : $rGroup;
                        }
                        else {
                                # first cycle
                                $roman = $self->_toRoman ( $group );
                        }
                }
                $lines .= "̄";
        }
        # $roman =~ s/̄̄/̿/g;
        $roman =~ s/\x{0304}/\x{033F}/g;
} else {
        while ( $number ) {
                if ( $number >= 10000 ) {
                        $roman .= "ↂ";
                        $number -= 10000;
                }
                elsif ( $number >= 9000 ) {
                        $roman .= "Ⅿↂ";
                        $number -= 9000;
                }
                elsif ( $number >= 5000 ) {
                        $roman .= "ↁ";
                        $number -= 5000;
                }
                elsif ( $number >= 4000 ) {
                        $roman .= "Ⅿↁ";
                        $number -= 4000;
                }
                elsif ( $number >= 1000 ) {
                        $roman .= "Ⅿ";
                        $number -= 1000;
                }
                elsif ( $number >= 900 ) {
                        $roman .= "ⅭⅯ";
                        $number -= 900;
                }
                elsif ( $number >= 500 ) {
                        $roman .= "Ⅾ";
                        $number -= 500;
                }
                elsif ( $number >= 400 ) {
                        $roman .= "ⅭⅮ";
                        $number -= 400;
                }
                elsif ( $number >= 100 ) {
                        $roman .= "Ⅽ";
                        $number -= 100;
                }
                elsif ( $number >= 90 ) {
                        $roman .= "ⅩⅭ";
                        $number -= 90;
                }
                elsif ( $number >= 50 ) {
                        $roman .= "Ⅼ";
                        $number -= 50;
                }
                elsif ( $number >= 40 ) {
                        $roman .= "ⅩⅬ";
                        $number -= 40;
                }
                elsif ( $number > 12 ) {
                        $roman .= "Ⅹ";
                        $number -= 10;
                }
                elsif ( $number >= 10 ) {
                        $number -= 10;
                        $number =~ tr/0-2/Ⅹ-Ⅻ/;
                        $roman .= $number;
                        $number = 0;
                }
                else {
                        $number =~ tr/1-9/Ⅰ-Ⅸ/;
                        $roman .= $number;
                        $number = 0;
                }
        }
}
        $roman;
}
sub upperRoman
{
my ( $self, $roman ) = @_;
        $roman =~ tr/ⅰ-ⅿ/Ⅰ-Ⅿ/;
        $roman;
}
sub lowerRoman
{
my ( $self, $roman ) = @_;
        $roman =~ tr/Ⅰ-Ⅿ/ⅰ-ⅿ/;
        $roman;
}
sub convert
{
my $self = shift;
        #
        # reset string if we've been passed one:
        #
        $self->_setArgs ( @_ ) if ( @_ );
        my $roman
        = ( $self->number =~ /^[0-9]+$/ )
          ? $self->_toRoman
          : $self->_fromRoman
        ;
        ( $self->{style} eq "upper" )
          ? $roman
          : $self->lowerRoman ( $roman )
        ;
}
sub number
{
my $self = shift;
        $self->_setArgs ( @_ ) || return
                if ( @_ );
        $self->{number};
}
sub style
{
my $self = shift;
        $self->_setArgs ( @_ ) || return
                if ( @_ );
        $self->{style};
}
#########################################################
# Do not change this, Do not put anything below this.
# File must return "true" value at termination
1;
##########################################################
__END__
HideShow 96 lines of Pod
=head1 NAME
Convert::Number::Roman - Convert Between Western and Roman Numeral Systems
=head1 SYNOPSIS
 #
 #  instantiate with a Western or Roman number (in UTF-8)
 #
 my $n = new Convert::Number::Roman( 4294967296 );
 my $romanNumber = $n->convert;
 $n->number ( 54321 );    # reset number handle
 print $n->convert, "\n";
 print $n->convert ( "lower" ), "\n";  # convert in lowercase numerals
 print "2003 => ", $n->convert ( 2003 ), "\n";  # convert new number
=head1 DESCRIPTION
Implementation of the Roman numeral conversion algorithm proposed for
the CSS3-List module specification.  Use to convert between Western and
Roman numeral systems under Unicode.
=over 4
=item See: L<http://www.w3.org/TR/css3-lists/>
=back
Roman numerals have both uppercase and lowercase styles.  The default
style used is the uppercase.  The default style can be set at instantiation
time as per:
 my $n = new Convert::Number::Roman( "lower" );
or
 my $n = new Convert::Number::Roman( 4294967296, "lower" );
The default style may also be set during conversion as per:
 $n->convert( "lower" );
or
 $n->convert( 4294967296, "lower" );
The C<style> method is also available to set or query the default style:
 my $style = $n->style;  # query style
 $n->style( "upper" );   # reset style
=head1 REQUIRES
The package is known to work on Perl 5.6.1 and 5.8.0 but has not been tested on
other versions of Perl by the author. 
=head1 COPYRIGHT
This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=head1 BUGS
None presently known.
=head1 AUTHOR
Daniel Yacob,  L<dyacob@cpan.org|mailto:dyacob@cpan.org>
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2003-2025, Daniel Yacob C<< <dyacob@cpan.org> >>. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
=head1 SEE ALSO
L<Math::Roman>    L<Text::Roman>    L<Roman>
L<Convert::Number::Coptic>    L<Convert::Number::Ethiopic>    L<Convert::Number::Digits>
Included with this package:
  examples/numbers.pl   examples/roman.pl
=cut