use v5.14;

package Role::Switchable
{
    use Moose::Role;
    
    has _switchable_base_class => (
        is        => 'ro',
        writer    => '_set_switchable_base_class',
        clearer   => '_clear_switchable_base_class',
        default   => sub { ref($_[0])->Moose::Util::find_meta },
        isa       => 'Class::MOP::Class',
    );
    
    has switchable_role => (
        init_arg  => undef,
        is        => 'ro',
        writer    => '_set_switchable_role',
        predicate => 'has_switchable_role',
        clearer   => '_clear_switchable_role',
        isa       => 'Moose::Meta::Role',
    );
    
    has _switchable_data => (
        init_arg  => 'switchable',
        is        => 'ro',
        writer    => '_set_switchable_data',
        clearer   => '_clear_switchable_data',
        default   => sub { +{} },
        isa       => 'HashRef[HashRef]',
    );
    
    sub BUILD { }
        
    after BUILD => sub
    {
        my ($self, $params) = @_;
        
        $self->_switchable_data->{_} = $params;
        
        if (my $role = delete $params->{switchable_role})
        {
            $self->switch_role($role);
        }
    };
    
    around dump => sub
    {
        my $next = shift;
        my $self = shift;
        
        my $tmp_class = $self->_switchable_base_class; $self->_clear_s
+witchable_base_class;
        my $tmp_role  = $self->switchable_role;        $self->_clear_s
+witchable_role;
        my $tmp_data  = $self->_switchable_data;       $self->_clear_s
+witchable_data;
        
        my $r = $self->$next(@_);
        
        $self->_set_switchable_base_class($tmp_class);
        $self->_set_switchable_role($tmp_role);
        $self->_set_switchable_data($tmp_data);
        
        return $r;
    };
    
    sub switch_role
    {
        my $self = shift;
        my ($new_role, %new_attrs) = @_;
        
        $new_role = $new_role->Moose::Util::find_meta
            if defined($new_role) && !ref($new_role);
        
        my $meta = $self->Moose::Util::find_meta;
        
        if ( $self->has_switchable_role )
        {
            my $current_role = $self->switchable_role;
            
            # Keep current attribute values
            my %attr_values;
            for ($current_role->get_attribute_list)
            {
                my $attr = $meta->find_attribute_by_name($_);
                $attr_values{ $attr->name } = $attr->get_value($self)
                    if $attr->has_value($self);
            }
            $self->_switchable_data->{ $current_role->name } = \%attr_
+values;
            
            # Rebless back to base class before applying new.
            $self->_switchable_base_class->rebless_instance_back($self
+);
            $self->_clear_switchable_role;
        }
        
        if ($new_role)
        {
            my %attrs = (
                %{ $self->_switchable_data->{ $new_role->name } or {} 
+},
                %new_attrs,
            );
            
            my $class = Moose::Util::with_traits($self->_switchable_ba
+se_class->name, $new_role->name);
            $self->_set_switchable_role($new_role);
            $class->Moose::Util::find_meta->rebless_instance($self, %a
+ttrs);
        }
        
        return;
    }
}

package Car
{
    use Moose::Role;
    has wheels => (is => 'rw');
    sub drive { say 'driving' }
}

package Plane
{
    use Moose::Role;
    has wings => (is => 'ro');
    sub fly { say 'flying' }
}

package Boat
{
    use Moose::Role;
    sub float { say 'floating' }
}

package Batmobile
{
    use Moose;
    has owner => (is => 'rw');
    with 'Role::Switchable';
}

my $bat = Batmobile->new(
    owner  => 'Bruce Wayne',
    switchable => {
        Plane => { wings => 'blue' },
        Car   => { wheels => 'red' },
    },
);

$bat->switch_role('Car');
say $bat->wheels, " wheels";
$bat->drive if $bat->can('drive');
$bat->fly if $bat->can('fly');
print $bat->dump;

$bat->switch_role('Boat');
$bat->owner('Batman');
print $bat->dump;

$bat->switch_role('Plane');
say $bat->wings, " wings";
$bat->drive if $bat->can('drive');
$bat->fly if $bat->can('fly');
print $bat->dump;
[download]