->cloneを持つクラス用のImmutableクラス

Immurable.pm

use strict;
use warnings;
use URI;
use DateTime;
use Test::More;

package Immutable {
    sub new {
        my ($class, $obj) = @_;
        bless {
            obj => $obj,
        }, $class;
    }

    sub get {
        my ($self) = @_;
        $self->{obj}->clone;
    }

    sub AUTOLOAD {
        my $self = shift;
        my $method = (split /::/, our $AUTOLOAD)[-1];
        return if $method eq 'DESTROY';
        my $new_obj = $self->get;
        $new_obj->$method(@_);
        (ref $self)->new($new_obj);
    }
};

subtest 'URI' => sub {
    my $uri = URI->new('http://example.com/');
    my $immutable_uri = Immutable->new($uri);

    my $immutable_uri2 = $immutable_uri->host('another.example.com');
    my $immutable_uri3 = $immutable_uri->scheme('https');

    is $uri->as_string, 'http://example.com/';
    is $immutable_uri->get->as_string, 'http://example.com/';
    isa_ok $immutable_uri, 'Immutable';
    is $immutable_uri2->get->as_string, 'http://another.example.com/';
    isa_ok $immutable_uri2, 'Immutable';
    is $immutable_uri3->get->as_string, 'https://example.com/';
    isa_ok $immutable_uri3, 'Immutable';

    $immutable_uri3->get->host('the.example.com');
    is $immutable_uri3->get->host, 'example.com';
};

subtest 'DateTime' => sub {
    my $now = DateTime->from_epoch(epoch => 1474355978);
    my $now_string = $now.q();
    my $immutable_datetime = Immutable->new($now);

    my $immutable_datetime2 = $immutable_datetime->set_year(2017);
    my $immutable_datetime3 = $immutable_datetime->add(years => 2);

    is $now, $now_string;
    is $immutable_datetime->get->year, 2016;
    isa_ok $immutable_datetime, 'Immutable';
    is $immutable_datetime2->get->year, 2017;
    isa_ok $immutable_datetime2, 'Immutable';
    is $immutable_datetime3->get->year, 2018;
    isa_ok $immutable_datetime3, 'Immutable';

    $immutable_datetime3->get->add(years => 1);
    is $immutable_datetime3->get->year, 2018;
};

done_testing;