in reply to call subroutine if scalar is changed

I see haj made the same suggestion as I was working on the following code: you can use tie to tie a scalar to a class, where you can customize the "fetch" and "store" events. See also perltie and Tie::Scalar. I tried this with your sample code and it works there as well.

use warnings;
use strict;

{
    package Tie::Scalar::Callbacks;
    sub TIESCALAR {
        my $class = shift;
        my %self;
        @self{qw/ val store_cb fetch_cb /} = @_;
        return bless \%self, $class;
    }
    sub FETCH {
        my $self = shift;
        $self->{fetch_cb}->($self->{val}) if $self->{fetch_cb};
        return $self->{val};
    }
    sub STORE {
        my $self = shift;
        my $val = shift;
        $self->{store_cb}->($self->{val}, $val) if $self->{store_cb};
        $self->{val} = $val;
    };
    sub DESTROY { %{shift()}=() }
}

tie my $name, 'Tie::Scalar::Callbacks', "foo",
    sub { print "storing <$_[1]>, was <$_[0]>\n" };
print "name is $name\n";
$name = "bar";
print "name is $name\n";

__END__

name is foo
storing <bar>, was <foo>
name is bar

[download]

Minor update to constructor.

Replies are listed 'Best First'.
Re^2: call subroutine if scalar is changed
by Anonymous Monk on Jun 08, 2019 at 13:26 UTC

    What I am doing wrong combining the two scripts?

    
use Tk;
my $mw = MainWindow->new();

{
    package Tie::Scalar::Callbacks;
    sub TIESCALAR {
        my $class = shift;
        my %self;
        @self{qw/ val store_cb fetch_cb /} = @_;
        return bless \%self, $class;
    }
    sub FETCH {
        my $self = shift;
        $self->{fetch_cb}->($self->{val}) if $self->{fetch_cb};
        return $self->{val};
    }
    sub STORE {
        my $self = shift;
        my $val = shift;
        $self->{store_cb}->($self->{val}, $val) if $self->{store_cb};
        $self->{val} = $val;
    };
    sub DESTROY { %{shift()}=() }
}


tie my $name, 'Tie::Scalar::Callbacks', "foo",
    sub { print "Entry value has changed!\n" };

my $label = $mw->Label(
    -text => 'Enter:',
)->grid(
    -row => 0,
    -column => 0,
);
my $entry = $mw->Entry(
    -textvariable => \$name
)->grid(
    -row => 0,
    -column => 1,
);

print "name is $name\n";
$name = "bar";
print "name is $name\n";
MainLoop;

    [download]

    (Note that I took away the button as I only a simulation of the third party component changing the scalar value)

[reply]
[d/l]
      You're changing the value before the main loop has been entered. Modify the final paragraph to 
      $mw->after(1000, sub {
    print "name is $name\n";
    $name = "bar";
    print "name is $name\n";
});
MainLoop;

      [download]
      map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
[reply]
[d/l]
[select]
      What I am doing wrong combining the two scripts?

      Nothing, as far as I can tell, other than that in this code you aren't changing $name once the main loop has been entered, as choroba pointed out.

      a simulation of the third party component changing the scalar value

      If it doesn't work with this third party component, then probably that is the culprit, and you'd have to tell us more about it and provide an SSCCE that reproduces the problem.

[reply]
[d/l]

In Section Seekers of Perl Wisdom