—
—
—
—
—
—
—
—

              
#!/usr/bin/perl
HideShow 21 lines of Pod
=head1 NAME
Text::Roman - Allows conversion between Roman and Arabic algarisms.
=head1 SYNOPSIS
 use Text::Roman qw/
    isroman roman2int int2roman ismilhar milhar2int
    roman mroman2int ismroman
    /;
         
 print int2roman(123);
 $roman = "XXXV";
 print roman2int($roman) if isroman($roman);
 $milhar = 'L_X_XXIII';     # = 60,023
 print milhar2int($milhar) if ismilhar($milhar);
=cut
# --- prologue ----------------------------------------------------------------
package Text::Roman;
require 5.000;
use warnings;
use strict;
use Exporter;
use vars qw/$VERSION @ISA @EXPORT_OK/;
$VERSION    = substr q$Revision: 3.02 $, 10;
@ISA        = qw/Exporter/;
@EXPORT_OK  = qw/
    int2roman roman2int isroman milhar2int ismilhar
    roman mroman2int ismroman
    /;
use vars qw/@RSN @RCN %R2A %A2R/;
@RSN = qw/I V X L C D M/;                       # Roman Simple Numerals
@RCN = qw/IV IX XL XC CD CM/;                   # Roman Complex Numerals
@R2A{@RSN, @RCN} = qw/
    1 5 10 50 100 500 1000 4 9 40 90 400 900
    /;                                          # numeric values
%A2R = reverse %R2A;                            # reverse for convenience
# --- module interface --------------------------------------------------------
HideShow 14 lines of Pod
=head1 DESCRIPTION
This package supports both conventional Roman algarisms (which range from 1 to 3999) and Milhar Romans, a variation which uses a bar across the algarism to indicate multiplication by 1,000.  For the purposes of this module, acceptable syntax consists of an underscore suffixed to the algarism e.g. IV_V = 4,005.  The term Milhar apparently derives from the Portuguese word for "thousands" and the range of this notation extends the range of Roman numbers to 3999 x 1000 + 3999 = 4,002,999.
Note: the functions in this package treat Roman algarisms in a case-insensitive manner such that "VI" == "vI" == "Vi" == "vi".
The following functions may be imported into the caller package by name:
=head2 isroman
Tests a string to be a valid Roman algarism.  Returns a boolean value.
=cut
sub isroman {
    local $_ = shift || $_;                             # roman algarism
     
    return if ! /^[@RSN]+$/;
    return if /([IXCM])\1{3,}|([VLD])\2+/i;             # tests repeatability
    my @re = qw/IXI|XCX|CMC/;
    for (1 .. $#RSN) {
        push @re, "$RSN[$_ - 1]$RSN[$_]$RSN[$_ - 1]";   # tests IVI
        push @re, "$RSN[$_]$RSN[$_ - 1]$RSN[$_]";       # and VIV conditions
        }
    my $re = join "|", @re;
    !/$re/;
    }
HideShow 6 lines of Pod
=head2 int2roman
Converts an integer expressed in Arabic numerals, to its corresponding Roman algarism.  If the integer provided is out of the range expressible in Roman notation, an I<undef> is returned.
=cut
sub int2roman {
    my $n = shift || $_;     # number, arabic numerals
    return unless $n > 0 && $n < 4000;
    my $ret = "";
    for (reverse sort { $a <=> $b } values %R2A) {
        $ret .= $A2R{$_} x int($n / $_);
        $n %= $_;
        }
    $ret;
    }
HideShow 6 lines of Pod
=head2 roman2int
Does the converse of I<int2roman()>, converting a Roman algarism to its integer value.
=cut
sub roman2int {
    local $_ = uc(shift || $_);    # roman algarism
    return unless isroman();
    my ($r, $ret, $_ret) = ($_, 0, 0);
    while ($r) {
        $r =~ s/^$_// && ($ret += $R2A{$&}, last) for @RCN, @RSN;
        return unless $ret > $_ret;
        $_ret = $ret;
        }
    $ret;
    }
HideShow 6 lines of Pod
=head2 ismilhar
Determines whether a string qualifies as a Milhar Roman algarism.
=cut
sub ismilhar {
    local $_ = shift || $_;
    return unless /^[_@RSN]+$/;
    my @r = split /_/;
    isroman() || return for @r;
    1;
    }
HideShow 6 lines of Pod
=head2 milhar2int
Converts a Milhar Roman algarism to an integer.
=cut
sub milhar2int {
    local $_ = shift || $_;
    return unless ismilhar();
    my @r = split /_/;
    my $ret = roman2int(pop @r);
    $ret += 1000 * roman2int() for @r;
    $ret;
    }
HideShow 16 lines of Pod
=head2 ismroman mroman2int roman
These functions belong to the module's old interface and are considered deprecated.  Do not use them in new code and they will eventually be discontinued; they map as follows:
=over
=item I<ismroman> => I<ismilhar>
=item I<mroman2int> => I<milhar2int>
=item I<roman> => I<int2roman>
=back
=cut
1;
__END__
HideShow 70 lines of Pod
=head1 CHANGES
Some changes worth noting from this module's previous incarnation:
=over
=item I<namespace imports>
The call to B<use> must now explicitly request function names imported into its namespace.
=item I<argument defaults/void context>
All functions now will operate on B<$_> when no arguments are passed, and will set B<$_> when called in a void context.  This allows for writing code like:
    @x = qw/V III XI IV/;
    roman2int() for @x;
    print join("-", @x);
instead of the uglier:
    @x = qw/V III XI IV/;
    $_ = roman2int($_) for @x;
    print join("-", @x);
=back
=head1 SPECIFICATION
Roman algarisms may be described using the following BNF-like formula:
    a   = I{1,3}
    b   = V\a?|IV|\a
    e   = X{1,3}\b?|X{0,3}IX|\b
    ee  = IX|\b
    f   = L\e?|XL\ee?|\e
    g   = C{1,3}\f?|C{0,3}XC\ee?|\f
    gg  = XC\ee?|\f
    h   = D\g?|CD\gg?|\g
    j   = M{1,3}\h?|M{0,3}CM\gg?|\h
=head1 REFERENCES
For a description of the Roman numeral system see: F<http://www.novaroma.org/via_romana/numbers.html>.  A reference to Milhar Roman alagarisms (in Portuguese) may be found at: F<http://www.estado.estadao.com.br/redac/norn-nro.html>.  
=head1 AUTHOR
Erick Calder <ecalder@cpan.org>
=head1 ACKNOWLEDGEMENTS
This module was originally written by Peter de Padua Krauss <krauss@ifqsc.sc.usp.br> and submitted to CPAN by Stanislaw Pusep <stanis@linuxmail.org> who has relinquished control to me since the original author has never maintained it and can no longer be reached.
I have completely rewritten the module, implementing simpler algorithms to perform the same functionality, adding a test suite, a Changes file, etc.  and providing more comprehensive documentation.
=head1 AVAILABILITY + SUPPORT
For questions, comments and support please feel free to e-mail me.  This module may be found on the CPAN.  Additionally, both the module and its RPM package are available from:
F<http://perl.arix.com>
=head1 DATE
$Date: 2003/01/16 01:12:15 $
=head1 VERSION
$Revision: 3.02 $
=cut