Heray-Was-Here
Server : Apache
System : Linux vps103298.mylogin.co 4.18.0-513.11.1.el8_9.x86_64 #1 SMP Wed Jan 17 02:00:40 EST 2024 x86_64
User : calvet ( 273824)
PHP Version : 7.4.33
Disable Function : NONE
Directory :  /usr/share/doc/perl-Mouse/t/001_mouse/

Upload File :
current_dir [ Writeable ] document_root [ Writeable ]

 

Current File : //usr/share/doc/perl-Mouse/t/001_mouse/801-coerce.t
use strict;
use warnings;
use Test::More tests => 6;

{
    package Headers;
    use Mouse;
    has 'foo' => ( is => 'rw' );
}

{
    package Response;
    use Mouse;
    use Mouse::Util::TypeConstraints;

    subtype 'HeadersType' => as 'Object' => where { $_->isa('Headers') };
    coerce 'HeadersType' =>
        from 'ScalarRef' => via {
            Headers->new();
        },
        from 'HashRef' => via {
            Headers->new(%{ $_ });
        }
    ;

    has headers => (
        is     => 'rw',
        isa    => 'HeadersType',
        coerce => 1,
    );
    has lazy_build_coerce_headers => (
        is     => 'rw',
        isa    => 'HeadersType',
        coerce => 1,
        lazy_build => 1,
    );
    sub _build_lazy_build_coerce_headers {
        Headers->new(foo => 'laziness++')
    }
    has lazy_coerce_headers => (
        is     => 'rw',
        isa    => 'HeadersType',
        coerce => 1,
        lazy => 1,
        default => sub { Headers->new(foo => 'laziness++') }
    );
}

my $r = Response->new(headers => { foo => 'bar' });
isa_ok($r->headers, 'Headers');
is($r->headers->foo, 'bar');
$r->headers({foo => 'yay'});
isa_ok($r->headers, 'Headers');
is($r->headers->foo, 'yay');
is($r->lazy_coerce_headers->foo, 'laziness++');
is($r->lazy_build_coerce_headers->foo, 'laziness++');


Hry