package Roman;
  

my %val = (
	   'M' => 1000,
	   'CM' => 900,
	   'D' => 500,
	   'CD' => 400,
	   'C' => 100,
	   'XC' => 90,
	   'L' => 50,
	   'XL' => 40,
	   'X' => 10,
	   'IX' => 9,
	   'V' => 5,
	   'IV' => 4,
	   'I' => 1,
	  );

my %rom = reverse %val;
my $rpat = join '|', sort {$val{$b} <=> $val{$a}} keys %val;
my @vals = sort {$b <=> $a} values %val;

sub import {
  my $pack = shift;
  my $caller = caller;
  my %args = @_;
  my $top = $args{Top} || 3999;
  my $i;
  for ($i=1; $i<= $top; $i++) {
    my $name = $caller . '::' . i2r($i);
    my $var;
    tie $var, $pack, $i;
    *{$name} = \$var;
  }
}

sub new {
  &TIESCALAR;
}

sub TIESCALAR {
  my $pack = shift;
  my $v = shift;
  bless \$v => $pack;
}

sub FETCH {
  my $self = shift;
  $$self;
}

sub r2i {
  my $r = shift;
  my $i = 0;
  while ($r =~ /\G($rpat)/og) {
    $i += $val{$1};
  }
  $i;
}

sub i2r {
  use Carp;
  my $i = shift;
  my $r = '';
  foreach $v (@vals) {
    while ($v <= $i) {
      $i -= $v;
      $r .= $rom{$v};
      return $r if $i ==0;
    }
  }
  croak "Can't convert number $i to Roman numeral";
}

sub stringize {
  my $self = shift;
  my $i = $$self;
  i2r($i);
}

sub STORE {
  use Carp;
  my $self = shift;
  my $val = $$self;
  my $rom = i2r($val);
  carp "Warning; Tried to modify the value of Roman numeral $rom";
  my $new = shift;
  $new;
}