#!/usr/bin/perl

use strict;
use warnings;

use My::DualVar;

my %table = ( 1 => 'NORTH',
              2 => 'SOUTH',
              3 => 'EAST',
              4 => 'WEST' );

# Case 1: Table num -> str
print "Case 1: Dualvar via num2str table\n\n";
{    
    my $direction = 2;
    My::DualVar->tie($direction, \%table);
    print_dualvar($direction);

    $direction = 4;
    print_dualvar($direction);

    $direction = 'NORTH';
    print_dualvar($direction);
}

# Case 2: Table str -> num
print "Case 2: Dualvar via str2num table\n\n";
{    
    my $direction = 'SOUTH';
    My::DualVar->tie($direction, reverse %table);
    print_dualvar($direction);

    $direction = 4;
    print_dualvar($direction);

    $direction = 'NORTH';
    print_dualvar($direction);
}

sub print_dualvar
{
    print "as num: " . ($_[0]+0) . "\n";
    print "as str: $_[0]\n";
    print "\n";
}

##</code><code>##

package My::DualVar;

use strict;
use warnings;

use Carp;
use Scalar::Util qw( dualvar looks_like_number );

sub tie
{
    # tie <class>, <scalar>, <arg1: scalar>, <arg2: table (hash or refhash)>
    tie $_[1], $_[0], $_[1], @_[2 .. $#_];
}

sub TIESCALAR
{
    my $class = shift;
    my $val = shift;

    croak "Given value is not defined" unless defined $val;

    my %table = @_ == 1 && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
    croak "Given table is empty" if keys %table == 0;
    die "Given value $val is not in table" unless exists $table{$val};

    # TODO: reject given table if values are not unique
    # Is there an efficient way to do this?

    my %reverse_table = reverse %table;

    my $impl;
    
    if( looks_like_number($val) )
    {
        # num table, i.e. key: num, value: str
        while (my ($num, $str) = each %table)
        {
            croak "Key $num of given table is not a number" unless looks_like_number($num);
            croak "Value $str of given table is not a string" if ref($str);
        }
        
        $impl = bless { '_val' => dualvar($val, $table{$val}), '_num_table' => \%table, '_str_table' => \%reverse_table }, $class;
    }
    else
    {
        # str table, i.e. key: str, value: num
        for my $num (values %table)
        {
            croak "Value $num of given table is not a number" unless looks_like_number($num);
        }        
        
        $impl = bless { '_val' => dualvar($table{$val}, $val), '_num_table' => \%reverse_table, '_str_table' => \%table }, $class;
    }

    return $impl;
}

sub FETCH
{
    my ($impl) = @_;
    return $impl->{'_val'};
}

sub STORE
{
    my ($impl, $val) = @_;

    if( looks_like_number($val) )
    {
        die "Invalid value $val" unless exists $impl->{'_num_table'}->{$val};    
        $impl->{'_val'} = dualvar($val, $impl->{'_num_table'}->{$val});
    }
    else
    {
        die "Invalid value $val" unless exists $impl->{'_str_table'}->{$val};    
        $impl->{'_val'} = dualvar($impl->{'_str_table'}->{$val}, $val);
    }
}

1;