Extending LValuable Subs with Tied Variables

[Limbic~Region]

All,
Today, perldeveloper (a new monk) asked in the CB if it was possible to make class method that can both set and get a value, but with post and pre-processing like C#. The following example was given:

$obj->Name = "My Name";
print $o->Name, "\n"; # "My Name, post processed".

I remembered Zaxo's post on validating data in lvaluable subs and that one of the replies mentioned it duplicating the work of Attribute::Property. After reading the POD, I realized that it doesn't quite fit the bill:

Your object must be a blessed hash reference. In short: $foo->bar = 14 and $foo->bar(14) assign 14 to $foo->{bar} after positive validation.

It limits the object type to a hash reference (which is most common), but then doesn't actually provide hooks for pre/post "processing". I came up with the following:

package magic;

sub TIESCALAR {
    my $class = shift;
    die "Incorrect number of parameters" if @_ % 2;
    my $self = bless {}, $class;
    $self->_Init(@_);
    return $self;
}

sub _Init {
    my ($self, %opt) = @_;
    $self->{PRE}  = $opt{PRE}  || sub { return uc $_[0] };
    $self->{POST} = $opt{POST} || sub {
        my $val = shift;
        $val =~ s/FOO/BAR/;
        return $val;
    };
    return;
}

sub STORE {
    my ($self, $value) = @_;
    $value = $self->{PRE}->(  $value );
    $value = $self->{POST}->( $value );
    $self->{VAL} = $value;
}

sub FETCH { return $_[0]->{VAL} }


########################################

package cool;

sub new {
    my $class = shift;
    tie my $name, "magic", @_;
    bless \$name, $class;
}

sub name :lvalue {
    ${$_[0]};
}

########################################

package main;

tie my $string, "magic";
$string = 'My left foot';
print "$string\n";

my $obj = cool->new( 'POST' => sub { return reverse $_[0] } );

$obj->name = "My right foot";
print $obj->name, "\n";

So - is there a better way of doing this? Is it hard to extend Attribute::Property to do what perldeveloper wanted? If this is the way to do it, how can it be wrapped up in a module like Attribute::Property to make it easier to use?

Update: Modified code to accept a code ref for pre/post hook instead of hardcoded

[nobull]

Maybe I can interest you in my Tie::OneOff module.

require Tie::OneOff;

package cool;

sub name : lvalue {
    my $self = shift;
    +Tie::OneOff->lvalue({
        STORE => sub { 
            my $val = shift;
            # Do whatever
            $self->{NAME} = $val;
        },
        FETCH => sub {
            $self->{NAME};
        },
    }); 
}

This module was the result of a discussion in comp.lang.perl.misc.

[husker]

Impressive.

Usually, my code acts like I used Tie::OneOn.

[Juerd]

If pre and post are always executed directly after eachother, then what's the use of separating them? What part of the story am I missing here?

use Attribute::Property;

package Cool;

sub new  : New;
sub name : Property { $_ = reverse uc; 1 }

package main;

my $obj = Cool->new;
$obj->name = "My right foot";
print $obj->name, "\n";

[Attribute::Property] doesn't actually provide hooks for pre/post "processing"

It provides a single hook for processing and validation: the code block. The value returned by it determines whether the new value is correct (hence the 1 in the example above), but both $_ and $_[1] are aliases for the value that is about to be set, so there's more than enough chance to manipulate the value before it gets assigned.

It should be noted that I also have no idea what C# does. I tried googling, but found only one sort-of relevant document, which has no examples and no explanation that I immediately grokked.

[Limbic~Region]

Juerd,
I was hoping you might reply.

If pre and post are always executed directly after eachother, then what's the use of separating them?

I just threw them in there as I wasn't given a real clear definition of how/when they were supposed to be invoked. I assume they would be separate but only perldeveloper can answer that

It provides a single hook for processing and validation: the code block. The value returned by it determines whether the new value is correct (hence the 1 in the example above), but both $_ and $_1 are aliases for the value that is about to be set, so there's more than enough chance to manipulate the value before it gets assigned.
There is a lot of history from the CB that this post did not capture. After posting it, I did mention in the CB that Attribute::Property might provide aliases in the validation allowing modification if necessary. It is my fault for not looking at the source and not updating my original post accordingly.

[Juerd]

I was hoping you might reply.

How could I not reply? :)

It is my fault for not looking at the source and not updating my original post accordingly.

It's documented even. Although it should have been made clearer that the value can also be modified. Currently, only the s/// in the SYNOPSIS really shows that feature.

[Zaxo]

The ideas are closely related, and so are the implementations, but my code really had nothing to do with pre/post processing. The purpose of the tied interface was to wedge the test into all mutators applied to the lvalue accessor sub. Hence the test is done in STORE().

The Constraint tie interface class written for that is really independent of lexical closures and lvalue subs. It could be applied directly to package globals or any other sort of scalar variable. The choice of die as an error reporting mechanism was from the "die is throw, eval is try" school of thought. I didn't want to muck up current values on bad assignments by returning undef or whatever.

One implementation of pre/post processing is done in TheDamian's Hook::LexWrap, a highly mystical module. I don't know if subs wrapped by that module can be lvalues, but I think I will have a good time finding out this evening :-)

[CountZero]

I saw this question just before I wanted to switch of my computer and go home.

I don't know why, but something says me that indeed tie-ing might be the solution for this matter.

[Limbic~Region]

CountZero,
Perhaps there is implied meaning in your statement or perhaps you didn't read my code. I am combining a tied variable and lvaluable subs. What do you mean?

[CountZero]

I did read your code, but missed the importance of the lvaluable subs reference somehow. Sorry if that confused you.

[Anonymous Monk]

Hi, Thanks for your support and advice. I adapted a bit L~R's code, but it basically is the same thing, lvalue subs redirected through tied variables. Below I give you what is most relevant, that is the end-user experience.

Creating a property-based class

package MyClass;

use strict;

use ObsceneEnabler;

our @properties = (
     "Name",
     "RegExp",
);

####################################
# Register properties for this class
####################################

ObsceneEnabler::RegisterProperties (@properties);


########################
# Class definition below
########################

sub get_RegExp {
     my $this = shift;

     unless ($this->regExp) {
          return "(?:" . $this->Name . ")";
     }

     return $this->regExp;
}


sub set_RegExp {
     my $this = shift;
     my $regexp = shift;
     $this->regExp = "(?:$regexp)";
}


sub SetMultiRegExp {
     my $this = shift;
     my $regexp = join ("|", @_);

     $this->RegExp = $regexp;
}


1;

Using a property-based class

use strict;

use MyClass;

my $o = new MyClass;
# Properties may also be initialized at construction time.
# my $o = new MyClass ({ RegExp => "Initial RegExp" });

$o->Name = "New Name";

print "Name: `" . $o->Name . "'\n";
print "RegExp: `" . $o->RegExp . "'\n";

$o->RegExp = "My RegExp";
print "RegExp: `" . $o->RegExp . "'\n";

$o->SetMultiRegExp ("My RegExp", "My Second RegExp");
print "Multi-set RegExp: `" . $o->RegExp . "'\n";

$o->regExp = "Hacked RegExp";

The output is:

Name: `New Name'
RegExp: `(?:New Name)'   (or RegExp: `(?:Initial RegExp)')
RegExp: `(?:My RegExp)'
Multi-set RegExp: `(?:My RegExp|My Second RegExp)'
Attempting to access private field `regExp'

Cheers, PerlDeveloper