Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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;

In reply to Re^2: Dualvar via table by Dirk80
in thread Dualvar via table by Dirk80

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (6)
As of 2021-05-12 19:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Perl 7 will be out ...





    Results (132 votes). Check out past polls.

    Notices?