Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Re^2: Dualvar via table

by Dirk80 (Pilgrim)
on Jan 19, 2020 at 12:45 UTC ( #11111606=note: print w/replies, xml ) Need Help??


in reply to Re: Dualvar via table
in thread Dualvar via table

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;

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://11111606]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (6)
As of 2020-03-30 09:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    To "Disagree to disagree" means to:









    Results (175 votes). Check out past polls.

    Notices?