r133 - in packages: . libroman-perl libroman-perl/branches libroman-perl/branches/upstream libroman-perl/branches/upstream/current

[Allard Hoeve]

Author: hoeve-guest
Date: 2004-06-10 08:18:41 -0600 (Thu, 10 Jun 2004)
New Revision: 133

Added:
   packages/libroman-perl/
   packages/libroman-perl/branches/
   packages/libroman-perl/branches/upstream/
   packages/libroman-perl/branches/upstream/current/
   packages/libroman-perl/branches/upstream/current/README
   packages/libroman-perl/branches/upstream/current/Roman.pm
   packages/libroman-perl/tags/
Log:
[svn-inject] Installing original source of libroman-perl

Added: packages/libroman-perl/branches/upstream/current/README
===================================================================
--- packages/libroman-perl/branches/upstream/current/README	2004-06-10 14:17:44 UTC (rev 132)
+++ packages/libroman-perl/branches/upstream/current/README	2004-06-10 14:18:41 UTC (rev 133)
@@ -0,0 +1,76 @@
+Roman.pm version 1.1
+
+NAME
+     Roman - Perl module for conversion between Roman and Arabic
+     numerals.
+
+SYNOPSIS
+             use Roman;
+
+             $arabic = arabic($roman) if isroman($roman);
+             $roman = Roman($arabic);
+             $roman = roman($arabic);
+
+DESCRIPTION
+     This package provides some functions which help conversion
+     of numeric notation between Roman and Arabic.
+
+INSTALLATION
+     Just copy Roman.pm into your perl module path.
+
+BUGS
+     Domain of valid Roman numerals is limited to less than 4000,
+     since proper Roman digits for the rest are not available in
+     ASCII.
+
+CHANGES
+     1997/09/03 Author's address is now <ozawa@aisoft.co.jp>
+
+AUTHOR
+     OZAWA Sakuro <ozawa@aisoft.co.jp>
+
+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.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Sun Release 4.1           Last change:                          1
+
+
+
+
+DESCRIPTION
+
+This package provides some functions which help conversion of numeric
+notation between Roman and Arabic.
+
+
+INSTALLATION
+
+Simply copy Roman.pm into your perl module path.
+
+AUTHOR
+
+OZAWA Sakuro <ozawa@prince.pe.u-tokyo.ac.jp>

Added: packages/libroman-perl/branches/upstream/current/Roman.pm
===================================================================
--- packages/libroman-perl/branches/upstream/current/Roman.pm	2004-06-10 14:17:44 UTC (rev 132)
+++ packages/libroman-perl/branches/upstream/current/Roman.pm	2004-06-10 14:18:41 UTC (rev 133)
@@ -0,0 +1,106 @@
+package Roman;
+
+=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 4000, since
+proper Roman digits for the rest are not available in ASCII.
+
+=head1 CHANGES
+
+1997/09/03 Author's address is now <ozawa@aisoft.co.jp>
+
+=head1 AUTHOR
+
+OZAWA Sakuro <ozawa@aisoft.co.jp>
+
+=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.
+
+=cut
+
+$RCS = '$Id: Roman.pm,v 1.2 1997/09/03 01:35:23 ozawa Exp $';
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(isroman arabic Roman roman);
+
+BEGIN {
+    %roman2arabic = qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);
+}
+
+sub isroman {
+    my($arg) = shift;
+    $arg ne '' and
+      $arg =~ /^(?: M{0,3})
+                (?: 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($last_digit) = 1000;
+    my($arabic);
+    foreach (split(//, uc $arg)) {
+        my($digit) = $roman2arabic{$_};
+        $arabic -= 2 * $last_digit if $last_digit < $digit;
+        $arabic += ($last_digit = $digit);
+    }
+    $arabic;
+}
+
+BEGIN {
+    %roman_digit = qw(1 IV 10 XL 100 CD 1000 MMMMMM);
+    @figure = reverse sort keys %roman_digit;
+    grep($roman_digit{$_} = [split(//, $roman_digit{$_}, 2)], @figure);
+}
+
+sub Roman {
+    my($arg) = shift;
+    0 < $arg and $arg < 4000 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;
+    }
+    $roman;
+}
+
+sub roman {
+    lc Roman shift;
+}
+
+1;