Thank you all so much. I never used the tie-functionality before. So I thought this could be a thing to use it. The same applies for dualvar. But now I see that this could be dangerous and too much magic.
So I was thinking a lot about all your answers. And now I took into account that the table is given only once (at compile time) to the class and not for each variable. I'm rejecting multi dimensionsal hashes. And I see that the tie functionality can be well replaced by the overload functionality via use overload '""' => \&str, '0+' => \&num, fallback => 1;.
Here my new suggestion, which seems to work fine:
Main program:
#!/usr/bin/perl
use strict;
use warnings;
use FindBin qw($Bin);
use Cwd qw(abs_path);
BEGIN{ unshift(@INC, abs_path("$Bin")) }
my %table;
BEGIN
{
%table = ( 1 => 'NORTH',
2 => 'SOUTH',
3 => 'EAST',
4 => 'WEST');
}
use My::GenDualVar "Direction", %table;
my $direction = Direction->new(2);
$direction->set('WEST');
print $direction->num() . "\n";
print $direction->str() . "\n";
print $direction->hex() . "\n";
# should work if overloading is active
#print $direction . "\n";
#print $direction+0 . "\n";
Package My::GenDualVar:
package My::GenDualVar;
use strict;
use warnings;
use Carp;
use Scalar::Util qw( looks_like_number );
no strict "refs";
sub import
{
croak "Parameters are missing. " .
"Parameters have to be the name of the to be generated class a
+nd " .
"an unique one dimensional table (hash) with numbers as keys a
+nd strings as values" unless @_ >= 3;
my $class = shift;
my $new_class = shift;
my %num_table = @_ == 1 && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
croak "Given table is empty" if keys %num_table == 0;
my %str_table = reverse %num_table;
keys %str_table == keys %num_table or croak qq{Given table @{[ %nu
+m_table ]} is not unique};
while (my ($num, $str) = each %num_table)
{
croak "Key $num of given table is not a number" unless looks_l
+ike_number($num);
croak "Value $str of given table is not a string" if ref($str)
+;
}
eval qq{package $new_class;\n} .
q{use overload '""' => \&str, '0+' => \&num, fallback => 1;};
My::GenDualVar->generate_new_for($new_class, \%num_table, \%str_ta
+ble);
My::GenDualVar->generate_set_for($new_class, \%num_table, \%str_ta
+ble);
My::GenDualVar->generate_num_for($new_class);
My::GenDualVar->generate_str_for($new_class);
My::GenDualVar->generate_hex_for($new_class);
}
sub generate_new_for
{
my ($class, $new_class, $ref_num_table, $ref_str_table) = @_;
*{"${new_class}::new"} = sub
{
my ($class, $val) = @_;
my $self = bless { '_num_table' => $ref_num_table, '_str_table
+' => $ref_str_table }, $class;
$self->set($val);
return $self;
}
}
sub generate_set_for
{
my ($class, $new_class, $ref_num_table, $ref_str_table) = @_;
*{"${new_class}::set"} = sub
{
my ($self, $val) = @_;
if( looks_like_number($val) )
{
croak "Invalid number $val in set method of class " . ref(
+$self) . ". " .
"Valid numbers are " . join(", ", sort{$a <=> $b} keys
+ %{$self->{'_num_table'}})
unless exists $self->{'_num_table'}->{$val};
$self->{'_num'} = $val;
$self->{'_str'} = $self->{'_num_table'}->{$val};
}
else
{
croak "Invalid string $val in set method of class " . ref(
+$self) . ". " .
"Valid strings are " . join(", ", sort keys %{$self->{
+'_str_table'}})
unless exists $self->{'_str_table'}->{$val};
$self->{'_num'} = $self->{'_str_table'}->{$val};
$self->{'_str'} = $val;
}
}
}
sub generate_num_for
{
my ($class, $new_class) = @_;
*{"${new_class}::num"} = sub
{
my ($self) = @_;
return $self->{'_num'};
}
}
sub generate_str_for
{
my ($class, $new_class) = @_;
*{"${new_class}::str"} = sub
{
my ($self) = @_;
return $self->{'_str'};
}
}
sub generate_hex_for
{
my ($class, $new_class) = @_;
*{"${new_class}::hex"} = sub
{
my ($self) = @_;
return sprintf("%#x", $self->{'_num'});
}
}
1;