use Test::More;
use Scalar::Util qw(reftype);
my $n_tests;
use_ok('Person');
BEGIN{ $n_tests++ }

# OBJECT

# instantiate object
my $p = Person->new;
is(ref $p,          'Person',      'object is Person');
is(reftype $p,      'SCALAR',      'object type is SCALAR');
BEGIN { $n_tests += 2 }

# set fullname by setting given and surname
$p->given =    'Xaver';
is($p->fullname,    'Xaver',       'fullname is givenName only');
$p->surname =  'Unsinn';
is($p->fullname,    'Xaver Unsinn','fullname is "givenName surname"');
BEGIN { $n_tests += 2 }

# set given and surname by setting fullname
$p->fullname = 'John Doe';
is($p->given,       'John',        'givenName is set after setting ful
+lname');
is($p->surname,     'Doe',         'surname is set after setting fulln
+ame');
BEGIN { $n_tests += 2 }

# dereferencing as hash - for confusion only ;-)
# is($p->{given},     'John',        'hash dereferencing of SCALAR is 
+correct');
# $p->{given} = 'Xaver';
# is($p->given,       'John',        '...which is correct, no setting 
+via hashref');
# is($p->{surname},   'Doe',         'hash dereferencing of SCALAR is 
+correct');
# is($p->{fullname},  'John Doe',    'hash dereferencing of SCALAR is 
+correct');
# BEGIN { $n_tests += 4 }

# CLASS

Person->fullname =  'Christian Surname';
is(Person->given,   'Christian',   'class attribute for given is set')
+;
is(Person->surname, 'Surname',     'class attribute for surname is set
+');
BEGIN { $n_tests += 2 }

BEGIN { plan tests => $n_tests }
[download]

package Person;
use strict; use warnings;
use Hash::Util::FieldHash qw(fieldhashes id);
use overload '%{}' => \&_refsub, fallback => 1;

fieldhashes \my(%given,%surname,%fullname);

# package attribute 'fullname'
tie $Person::fullname{Person}, 'Person::fullname', 'Person';

sub new {
    my $class = shift;
    my %args = @_;
    my $obj = bless do{ \my $x }, $class;
    for(qw{given surname}) {
        $obj->$_ = $args{$_} if $args{$_};
    }
    tie $fullname{$obj}, 'Person::fullname', $obj;
    $obj;
}

# make getters/setters
for (qw{given surname fullname}) {
    eval "sub $_ : lvalue { \$${_}{shift()} }";
}

# provide $obj->{attribute} syntactic sugar - for more confusion
# sub _refsub {
#     my $obj = shift;
#     warn "WARNING: dereferencing $obj as hashref is deprecated\n";
#     warn "WARNING: setting an attribute via hashref does NOT work\n"
+;
#     {
#         given    => $obj->given,
#         surname  => $obj->surname,
#         fullname => $obj->fullname,
#     };
# }

# tied interface for compound attribute 'fullname'
package Person::fullname;

sub TIESCALAR {
    my $class = shift;
    my $obj   = shift;
    my $tied  = bless \$obj, $class;
}

sub FETCH {
    my $obj = shift;
    join" ", grep {length} $$obj->given,$$obj->surname;
}
sub STORE {
    my $obj            = shift;
    my ($first, $last) = split /\s+/,shift;
    $$obj->given       = $first;
    $$obj->surname     = $last;
}
1;
[download]