#!/usr/bin/perl use warnings; use strict; use feature qw{ say }; { package LanX; use overload '%{}' => \&_nothing, '""' => sub { $_[0]->_underload(\&_value) }; sub new { bless {value => $_[1]}, $_[0] } sub inc { $_[0]->_underload(sub { ++$_[0]->{value} }) } sub value { $_[0]->_underload(\&_value) } sub _nothing { { value => 'nothing' } } sub _value { $_[0]->{value} } sub _underload { my ($self, $sub) = @_; overload->unimport('%{}'); my $v = $self->$sub; overload->import('%{}' => \&_nothing); return $v } } my $l = 'LanX'->new(12); say "deref\t" => $l->{value}; # nothing say "l\t" => $l; # 12 say "deref\t" => $l->{value}; # nothing say "inc\t" => $l->inc; # 13 say "l\t" => $l; # 13 say "inc\t" => $l->inc; # 14 say "l\t" => $l; # 14 say "deref\t" => $l->{value}; # nothing