Skip to content

Instantly share code, notes, and snippets.

@run4flat
Created February 10, 2012 15:29
Show Gist options
  • Save run4flat/1790290 to your computer and use it in GitHub Desktop.
Save run4flat/1790290 to your computer and use it in GitHub Desktop.
Using Want to validate lvalue methods (why is this not used everywhere, especially MooseX::Meta::Attribute::Lvalue?)
use strict;
use warnings;
# Create a new person, give him some cash:
my $david = Person->new(name => 'David', age => '29');
$david->wallet->cash = 30;
print $david->name, ' has $', $david->wallet->cash, "\n"; # $30
# This doesn't work, for reasons not clear to me:
$david->wallet->cash -= 10;
print $david->name, ' has $', $david->wallet->cash, "\n"; # $30
# This works fine:
$david->wallet->cash = 20;
print $david->name, ' has $', $david->wallet->cash, "\n"; # $20
# This *DOES NOT CHANGE DAVID'S CASH* and prints a message why:
$david->wallet->cash = -20;
print $david->name, ' has $', $david->wallet->cash, "\n"; # $20 (positive)
my $fake_wallet = 'monies';
$david->wallet = $fake_wallet; # prints "This ain't no..."
print $david->name, ' has $', $david->wallet->cash, "\n"; # $20
my $real_wallet = Wallet->new(cash => 45);
$david->wallet = $real_wallet; # prints "Ooh, a new wallet!..."
print $david->name, ' has $', $david->wallet->cash, "\n"; # $45
package Person;
use Want;
# Very simple hash-based Person who starts peniless.
sub new {
my $class = shift;
return bless {
name => 'Joe',
age => 25,
wallet => Wallet->new,
@_,
};
}
# No changing the name:
sub name {
return $_[0]->{name};
}
# Age can change, but let's not worry about validation at the moment:
sub age :lvalue {
return $_[0]->{age};
}
sub wallet :lvalue {
my $self = shift;
if (want(qw'LVALUE ASSIGN')) {
# Someone's giving us a new wallet! How nice!
my ($new_wallet) = want('ASSIGN');
my $old_wallet = $self->{wallet};
# First make sure it's really a wallet!
if (not eval{ $new_wallet->isa('Wallet') }) {
print "This ain't no stinkin' wallet!\n";
lnoreturn;
}
# It *is* a new wallet, so take it and transfer the cash out of the
# old wallet into the new one:
else {
print "Ooh, a new wallet! I'll take it!\n";
$self->{wallet} = $new_wallet;
lnoreturn;
}
}
else {
# Just pullin' out our wallet:
return $self->{wallet};
}
return;
}
package Wallet;
use Want;
# New wallets ony have cash if somebody put it there for us, so the 'default'
# value is zero dollars:
sub new {
my $class = shift;
return bless {
cash => 0.0,
@_
};
}
sub cash :lvalue {
my $self = shift;
if (want(qw'LVALUE ASSIGN')) {
my $new_cash = want('ASSIGN');
if ($new_cash < 0) {
print "Can't hold a negative value in a wallet; not changing\n";
}
else {
$self->{cash} = $new_cash;
}
lnoreturn;
}
else {
return $self->{cash};
}
return;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment