Dualvar via table

[Dirk80]

I often have the case when reading a binary value from a file that it also has a textual representation. So I can use the dualvar functionality of Scalar::Util to solve this issue.

But that's not enough for me. Usually I have a corresponding table which contains the valid values and its representations. To avoid doing the same checks so often in code, I decided to tie the read scalar variable to a package which is doing these checks for me. Additionally on a change it shall always update the numeric and string context.

Here an example:

#!/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";
}

And here my written package:

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 ref
+hash)>
    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 loo
+ks_like_number($num);
            croak "Value $str of given table is not a string" if ref($
+str);
        }
        
        $impl = bless { '_val' => dualvar($val, $table{$val}), '_num_t
+able' => \%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 l
+ooks_like_number($num);
        }        
        
        $impl = bless { '_val' => dualvar($table{$val}, $val), '_num_t
+able' => \%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;

This code is working. But I would be interested in your opinion. What could I do better?

And the second thing. Currently my code would work randomly if the values of the given table (hash) are not unique. Is there an efficient way to check whether the values of a hash are unique? Then I would reject such a hash

Or would there be a solution to return several values if the hash is not unique, e.g. key 2 and 5 would have value 'SOUTH'?

In numeric context it would not work. If I would set a dualvar variable to 'SOUTH', then I would have to return 2 or 5 in the FETCH-method. Perhaps in numeric context the smaller value should be returned.

In string context I think it is possible. Because I could give back a concatenated string and I still would have a scalar.

[davido]

I almost typed 90% of what LanX responded with, and even had some example code that was in some ways similar to his. Glad I checked before posting. I may include it at the bottom just as another demonstration.

Here is my concern, and it's similar also to LanX's: Conceptually the scalar container has a payload, and it has the ability to represent that payload according to the context provided by the operators that are acting upon it. The fact that this data polymorphism is implemented by encapsulating a PV (string pointer), NV (floating point pointer), IV (integer value), and a few other internal buckets into the scalar is how Perl manages to make this polymorphism computationally efficient at the expense of some memory. Using these buckets that house the representations of the data contained in a scalar variable as multiple entities is risky because it assumes that the subset of Perl you know will be acting on this scalar variable will not cause any clobbering or other attempts to bring the representations into consistency. But this is a subset of Perl. There is only a subset of scalars that will qualify for this treatment, depending on how they're created and used elsewhere in the script.

Whomever works with this variable needs to assure that they don't use parts of Perl that might have a problem with the inconsistency, and also make sure to be using the parts of Perl that do follow the PV/IV/NV internals pattern. That second part means not using tie. The first part means all bets are off if the variable passes through a module that implements XS XSubs in a way that are oblivious and possibly incompatible with dualvars. You are also taking serialization risks: If someone decides to compose your variable into a part of a structure that gets converted to JSON, all bets are off whether it will be treated as a string or a number. Well, that's maybe a little too glib, but different JSON encoders follow subtly different rules.

I'm also not a tremendous fan of overloading in most code, as I've seen what it can become in languages where it is more prolific. It still involves a form of spooky action at a distance. It works out fairly well for Math::BigInt, and a few other places, though. So I wouldn't disqualify it completely. But I would prefer creating an object that has explicit accessors for the data and for the text. Nevertheless, overloading is at least a language feature for Perl rather than an implementation detail, and comes with better guarantees and simpler rules. So it's possibly a reasonable solution for you.

All that said, here's the code that I was going to use as an example before noticing that LanX beat me to it:

Read more... (853 Bytes)

[roboticus]

Dirk80:

It appears (from my casual reading) that each tie would create a new copy of the table, so extensive use may cost more time and memory than needed. So you might want to have a function in My::DualVar that creates the table, and then you can tie the table to variables as necessary. I haven't played with tying variables (much or recently), so I'm sure my syntax is (likely to be) wrong, but what I'm thinking is something that would give you usage something like:

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

my $table_fwd = My::DualVar->new(%directions);
my $table_rev = My::DualVar->new(reverse %directions);

tie $direction, \$table_fwd;

my ($dir, $dir2) = (4, 1);
tie $dir,  \$table_fwd;
tie $dir2, \$table_fwd;

print_dualvar($dir);
++$dir2;
print_dualvar($dir2);

tie $dir2, \$table_rev;
for $dir2 (qw(SOUTH WEST EAST)) {
    $dir = $dir2 + 0;
    print_dualvar($dir);
}

I've thought a little about using the dual nature of variables in some perl code, but haven't actually taken the plunge. (What I was thinking was along the lines of parsing a file, and keeping the original representation of a number in the string section so that if calculations are unexpected, I can see what string led to the fault. As a terrible example, suppose I was reading the number part of a street address into a variable (using a stupid technique):

use strict;
no warnings;  # !!!

my @addresses = (
    "1141 Tennessee Avenue",
    "12E10th Street"
);

for (@addresses) {
    my $house_number = $_+0;
    print "House# across the street is ", $house_number+1, "\n";
    print "DEBUG: Original house number '$house_number'\n\n";
}

Which prints:

$ perl t.pl
House# across the street is 1142
DEBUG: Original house number '1141'

House# across the street is 120000000001
DEBUG: Original house number '120000000000'

Where I would want to see:

House# across the street is 1142
DEBUG: Original house number '1141 Tennessee Avenue'

House# across the street is 120000000001
DEBUG: Original house number '12E10th Street'

...roboticus

When your only tool is a hammer, all problems look like your thumb.

[LanX]

> I've thought a little about using the dual nature of variables in some perl code, but haven't actually taken the plunge

I'm not sure if it's a good idea. Perl is adjusting the slots to each other depending on use history.

Hence you'd magically loose information, and I'm not aware of a way to inhibit this.

That's awfully hard to debug if it happens.

(will add an example later)

update

Playing around, look at what happens at line 7

  DB<3> use Scalar::Util qw(dualvar);

  DB<4> $v = dualvar 137, 'Buster';

  DB<5> p "$v" 
Buster
  DB<6> p 0+$v
137
  DB<7> p $v++    # read string, increment number
Buster
  DB<8> p $v++    # what...?
138
  DB<9> p "$v"
139
  DB<10>

after incrementing $v, i.e. changing it in numeric context, the string-slot is adjusted to the number-slot°

So can this only happen when I change one of the slots?

If yes, shouldn't such dualvars always been made readonly, too?

Hope you understand my worries.

update

°) or some flags are changed. Who knows....

FWIW: a very good article from Brian here: https://www.effectiveperlprogramming.com/2011/12/create-your-own-dualvars/

[roboticus]

LanX:

Yeah, it could be problematic. I haven't put any thought into its ramifications.

...roboticus

When your only tool is a hammer, all problems look like your thumb.

[AnomalousMonk]

I share the concerns of others about mixing too much Perl majick together: the result may blow up in your (or your maintainer's) face in very unexpected ways. But as to some tangential questions...

Is there an efficient way to check whether the values of a hash are unique?

c:\@Work\Perl\monks>perl -wMstrict -le
"my %h = qw(a 1  b 2  c 3  d 1);
 ;;
 my %r = reverse %h;
 keys %r == keys %h or die qq{hash @{[ %h ]} not unique};
"
hash c 3 a 1 b 2 d 1 not unique at -e line 1.

... a solution to return several values if the hash is not unique ...

The general approach to maintaining several values for a hash key is an anonymous array. Maybe something like:

c:\@Work\Perl\monks>perl -wMstrict -le
"use Data::Dump qw(dd);
 ;;
 my %h = (
   a => [ 1 ],  b => [ 2, 99, 88 ],  c => [ 3 ],  d => [ 1, 99 ]
   );
 ;;
 my %r;
 for my $hk (keys %h) {
   push @{ $r{$_} }, $hk for @{ $h{$hk} };
   }
 dd \%r;
"
{ 1 => ["a", "d"], 2 => ["b"], 3 => ["c"], 88 => ["b"], 99 => ["b", "d
+"] }

Update: Note that this inversion approach for multi-value hashes is not round-tripable unless you consider the arrays of values to be unordered lists:

c:\@Work\Perl\monks>perl -wMstrict -le
"use Test::More 'no_plan';
 use Test::NoWarnings;
 ;;
 use Data::Dump qw(dd);
 ;;
 my %h = (
   a => [ 1 ], b => [ 2, 99, 88 ], c => [ 3 ], d => [ 1, 99 ]
   );
 ;;
 my %r  = invert(%h);
 dd \%r;
 ;;
 my %rr = invert(%r);
 dd \%rr;
 ;;
 is_deeply \%rr, \%h, 'round trip';
 ;;
 done_testing;
 ;;
 exit;
 ;;
 sub invert {
   my %h = @_;
   my %r;
   for my $hk (keys %h) {
     push @{ $r{$_} }, $hk for @{ $h{$hk} };
     }
   return %r;
   }
"
{ 1 => ["a", "d"], 2 => ["b"], 3 => ["c"], 88 => ["b"], 99 => ["b", "d
+"] }

{ a => [1], b => [99, 88, 2], c => [3], d => [99, 1] }

not ok 1 - round trip
#   Failed test 'round trip'
#   at -e line 1.
#     Structures begin differing at:
#          $got->{b}[0] = '99'
#     $expected->{b}[0] = '2'
1..1
ok 2 - no warnings
1..2
# Looks like you failed 1 test of 2.

[Dirk80]

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;

[LanX]

Concerning your code ... TL;DR ... sorry!

But

> This code is working. But I would be interested in your opinion. What could I do better?

dualvar means fiddling with internals, especially if you need to tie it with even more magic, too.

I'd reserve this approach for really hard to achieve stuff or temporary tricks (like for debugging)

IMHO using OOP together with overload for stringification and numification (see overload# String, numeric, boolean, and regexp conversions ) offers a much better interface and is easier to maintain. (untested!°)

HTH! :)

update

°) see Cookbook section in overload for an example

# Two-face Scalars

# Put this in two_face.pm in your Perl library directory:

      package two_face;        # Scalars with separate string and
                                    # numeric values.
      sub new { my $p = shift; bless [@_], $p }
      use overload '""' => \&str, '0+' => \&num, fallback => 1;
      sub num {shift->[1]}
      sub str {shift->[0]}

# Use it as follows:

      require two_face;
      my $seven = two_face->new("vii", 7);
      printf "seven=$seven, seven=%d, eight=%d\n", $seven, $seven+1;
      print "seven contains 'i'\n" if $seven =~ /i/;

# (The second line creates a scalar which has both a string value, and
+ a numeric value.) This prints:

      seven=vii, seven=7, eight=8
      seven contains 'i'