UNIVERSAL-Object

 view release on metacpan or  search on metacpan

lib/UNIVERSAL/Object.pm  view on Meta::CPAN

    Carp::confess('Invalid BLESS args for '.$class.', You must specify an instance prototype as a HASH ref')
        unless defined $proto && ref $proto eq 'HASH';

    my $instance = $class->CREATE( $proto );

    Carp::confess('CREATE must return a reference to bless, not '.$instance)
        unless defined $instance && ref $instance;

    my $repr = ref   $instance;
    my $self = bless $instance => $class;

    # So,... for HASH based instances we'll
    # lock the set of keys so as to prevent
    # typos and other such silliness, if
    # you use other $repr types, you are
    # on your own, ... sorry ¯\_(ツ)_/¯
    if ( $repr eq 'HASH' ) {
        my %slots = $self->SLOTS;
        Hash::Util::lock_keys( %$self, keys %slots );
    }

t/010-object/003-BLESS.t  view on Meta::CPAN

{
    package Foo;
    use strict;
    use warnings;
    our @ISA; BEGIN { @ISA = ('UNIVERSAL::Object') };
    our %HAS; BEGIN { %HAS = (foo => sub { 'FOO' }) };

    sub BLESS {
        my ($class, $proto) = @_;
        my $self = { %$proto };
        return bless $self => $class;
    }
}

{
    my $o = Foo->new;
    isa_ok($o, 'Foo');
    isa_ok($o, 'UNIVERSAL::Object');

    ok(not(exists $o->{foo}), '... got the expected slot');
    is($o->{foo}, undef, '... the expected slot has the expected value');

t/010-object/100-inherit-from-non-UO-class.t  view on Meta::CPAN

=cut

{
    package Bar;
    use strict;
    use warnings;

    sub new {
        my $class = shift;
        bless { @_ } => $class;
    }

    sub bar { $_[0]->{bar} }
}

{
    package Foo::Bar;
    use strict;
    use warnings;
    our @ISA; BEGIN { @ISA = ('UNIVERSAL::Object', 'Bar') };

t/010-object/101-inherit-from-non-UO-class.t  view on Meta::CPAN

=cut

{
    package Baz;
    use strict;
    use warnings;

    sub new {
        my ($class, $value) = @_;
        bless { baz => $value } => $class;
    }

    sub baz { $_[0]->{baz} }
}

{
    package Foo::Baz;
    use strict;
    use warnings;
    our @ISA; BEGIN { @ISA = ('UNIVERSAL::Object', 'Baz') };

t/020-slots/010-simple-slot-object.t  view on Meta::CPAN

{
    package My::Slot;
    use strict;
    use warnings;

    use overload '&{}' => 'to_code';

    sub new {
        my ($class, %args) = @_;
        bless { %args } => $class;
    }

    sub to_code {
        my ($self) = @_;
        sub { $self->{default}->( @_ ) };
    }
}

{
    package Foo;

 view all matches for this distribution
 view release on metacpan -  search on metacpan