How to update a Perl/Tk widget textvariable that is a moose attribute?

问题

In Perl/Tk, one can define textvariables for widgets. It's a reference to some scalar that holds the value. Someone showed me how to use Moose attribute coercion to use Moose attributes as textvariable (cool!). This is how it works:

subtype 'TkRef' => as 'ScalarRef';
coerce 'TkRef', from 'Str', via { my $r = $_; return \$r };
has 'some_val' => (is => 'rw', isa => 'TkRef', coerce => 1, default => 'default value');

$mw->Entry(-textvariable => $self->some_val);
$mw->Label(-textvariable => $self->some_val); # will always Show what we type into the entry

However, when I want to set a new value for the attribute, I have to dereference it like this:

${$self->some_val} = 'blarg'; # dereference

Simply setting the attribute won't work, as the reference needs to remain the same over the life of the object (that is, the attribute value itself cannot change).

Is there a way to use the nice Moose attribute coerce feature without losing the possibility to set the attribute with $self->some_val('blarg'); ? Some sort of reverse-coercion?

回答1:

Make the accessors private, and then provide a wrapper for the accessor. Something like this:

subtype 'TkRef', as 'ScalarRef';
coerce 'TkRef', from 'Str', via { my $r = $_; return \$r };

has _some_val => (
   is       => 'rw',
   isa      => 'TkRef',
   coerce   => 1,
   init_arg => 'some_val',
   default  => 'default value',
);

sub some_val {
   my $self = shift;
   if (@_ and not ref $_[0]) {
      ${$self->_some_val} = shift;
   }
   elsif (@_ and ref $_[0]) {
      ${$self->_some_val} = ${+shift};
   }
   $self->_some_val(@_);
}

来源：https://stackoverflow.com/questions/23396627/how-to-update-a-perl-tk-widget-textvariable-that-is-a-moose-attribute

标签

perl

moose