lvalue accessors

lvalue_accessor.pl

#!/usr/bin/env perl
 
use strict;
use warnings;
use v5.10;
 
package Moo::LvalueAccessor;

use Scalar::Util qw/weaken/;
use parent 'Exporter';
our @EXPORT = 'AUTOLOAD';
 
sub TIESCALAR {
  my ($class, $attr, $invocant) = @_;
  weaken( my $self = $invocant );
  my $curry = sub {
    return unless $self;
    $self->$attr(@_);
  };
  bless $curry, $class;
}
 
sub FETCH { $_[0]->() }
sub STORE { $_[0]->($_[1]) }
 
sub AUTOLOAD :lvalue {
  my $self = shift;
  my $attr = '_' . (split /::/, our $AUTOLOAD)[-1];
  return unless $self->can($attr);
 
  tie my $var, __PACKAGE__, $attr => $self;
  $var;
}
 
package Person;
 
use Moo;
Moo::LvalueAccessor->import; # use Moo::LvalueAccessor
 
has '_money' => (
  is => 'rw',
  default => sub { 0 },
  init_arg => 'money',
);
 
sub payday {
  my ($self, $amount) = @_;
  $self->money += $amount;
}
 
package main;
 
my $person = Person->new;
$person->payday( 200 );
$person->payday( 400 );
 
say $person->money;