gistfile1.PL

use strict;
use warnings;

#--------------------------------------------------------
package MooseX::TrackingDefault;
use Moose::Role;
use Carp;

has tracks => (
    is          => 'rw',
    predicate   => 'tracks_property',
);

around accessor_metaclass => sub {
    my ($orig, $self, @rest) = @_;

    return Moose::Meta::Class->create_anon_class(
        superclasses => [ $self->$orig(@_) ],
        roles => [ 'MooseX::TrackingDefault::Accessor' ],
        cache => 1
    )->name;
};

#--------------------------------------------------------
package MooseX::TrackingDefault::Accessor;
use Moose::Role;
 
around _inline_get => sub {
    my ($orig, $self, $instance, $value) = @_;

    my $tracks  = $self->associated_attribute->tracks;
    my $name    = $self->associated_attribute->name;
    my $code    = sprintf 
         qq| ( '$tracks' && !%s->meta->get_attribute('$name')->has_value( %s ) ) |
        .qq|     ? %s->meta->get_attribute('$tracks')->get_value( %s )           |
        .qq|     : %s                                                            |
        .qq|     ;                                                               |,
        $instance, $instance,
        $instance, $instance,
        $self->$orig($instance, $value),
    ;

    return $code;
};

#--------------------------------------------------------
package Moose::Meta::Attribute::Custom::Trait::TrackingDefault;
sub register_implementation {'MooseX::TrackingDefault'};


#--------------------------------------------------------
package TestMooseTrack;
use Moose;

    has color  => (
        is      => 'rw',
        default => 'red',
    );

    has line_color     => (
        traits      => [ qw{ TrackingDefault } ],
        tracks      => 'color',
        is          => 'rw',
    );

    has font_color  => (
        traits      => [ qw{ TrackingDefault } ],
        tracks      => 'color',
        is          => 'rw',
    );

#--------------------------------------------------------
package main;

my $t = TestMooseTrack->new;

# Should be red red red
print join ' ', $t->color, $t->line_color, $t->font_color, "\n";

$t->color( 'green' );

# Should be green green green
print join ' ', $t->color, $t->line_color, $t->font_color, "\n";

$t->line_color( 'pink' );

# Should be green pink green
print join ' ', $t->color, $t->line_color, $t->font_color, "\n";

$t->color( 'blue' );

# Should be blue pink blue
print join ' ', $t->color, $t->line_color, $t->font_color, "\n";