Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid

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

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

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

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

    How do I use this? | Other CB clients
    Other Users?
    Others examining the Monastery: (3)
    As of 2021-03-01 05:20 GMT
    Find Nodes?
      Voting Booth?

      No recent polls found