README.md

SYNOPSIS

package My::Model;
use strict;
use warnings;

use Class::Extensible qw(clone_with);
use Class::Accessor::Lite(
    new => 1,
    ro => [qw(foo bar)],
);

sub with_baz {
    my ($self, $baz) = @_;
    return $self->clone_with('WithBaz', baz => $baz);
}

1;

package My::Model::WithBaz;
use strict;
use warnings;

use parent qw(My::Model);
use Class::Accessor::Lite(
    new => 1,
    ro  => [qw(baz)],
);

1;

use My::Model;

my $obj = My::Model->new(foo => 3, bar => "bar");
$obj->isa('My::Model');          # 1 (true)
$obj->isa('My::Model::WithBaz'); # '' (false)
$obj->foo; # 3
$obj->bar; # "bar"
#$obj->baz; # Can't locate object method "baz" via package "My::Model" at test.pl line 11.

my $extended = $obj->with_baz(['baz']);
$extended->isa('My::Model');          # 1 (true)
$extended->isa('My::Model::WithBaz'); # 1 (true)
$extended->foo; # 3
$extended->bar; # "bar"
$extended->baz; # ["baz"]

Extensible.pm

package Class::Extensible;
use strict;
use warnings;

use Class::Load qw(load_class);
use Class::Mix qw(mix_class);
use List::MoreUtils qw(uniq);

my $Stash = '_EXTENDED_WITH';

sub import {
    my ($class, @exports) = @_;
    my %exports = map { $_ => 1 } @exports;
    my $package = caller;
    my $prefix = "${package}::";

    no strict 'refs';

    *{"${package}::clone_with"} = sub {
        my ($self, $other, %args) = @_;
        my $class = ref($self);

        $other = "${prefix}${other}"
            unless $other =~ /::/;
        load_class $other;

        my @classes = scalar @{"${class}::${Stash}"}
            ? @{"${class}::${Stash}"}
            : ($class);
        @classes = grep { # uniquify
            !$other || do {
                if ($_->isa($other)) {
                    $other = undef;
                    1;
                } else {
                    !$other->isa($_);
                }
            };
        } @classes;
        push @classes, $other if $other;
        @classes = sort @classes;

        my $new_class = mix_class(@classes, {
            prefix => $prefix,
            mro    => 'c3',
        });
        @{"${new_class}::${Stash}"} = @classes;

        return $new_class->new(%$self, %args);
    } if delete $exports{clone_with};
}

1;