MOP

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

        - it is a blessed CODE reference

    [ MOP::Method ]
    - the API for `get_code_attributes` in MOP::Method has
      changed, it now returns MOP::Method::Attribute objects

    [DEPENDENCIES]
    - added Sub::Metadata, used to detect null CVs and
      mutate the COMP_STASH of CVs.
    - added Devel::Hook, which is used in the new MOP::Util
      function `defer_until_UNITCHECK`
    - bumped the UNIVERSAL::Object dependency version to
      make sure we have support for immutable CODE ref
      instances (needed for MOP::Slot::Initializer)

0.09 2017-09-27
    [ENHANCEMENT]
    - moved the Slot::Intitializer class from Moxie back
      to this level, I believe it is more appropritate

0.08 2017-08-08

lib/MOP/Class.pm  view on Meta::CPAN

use MOP::Slot;

use MOP::Internal::Util;

our $VERSION   = '0.14';
our $AUTHORITY = 'cpan:STEVAN';

use parent 'UNIVERSAL::Object::Immutable';

our @DOES; BEGIN { @DOES = 'MOP::Role' }; # to be composed later ...
UNITCHECK {
    # apply them roles  ...
    MOP::Internal::Util::APPLY_ROLES(
        MOP::Role->new( name => __PACKAGE__ ),
        \@DOES,
        to => 'class'
    );
}

# superclasses

lib/MOP/Internal/Util.pm  view on Meta::CPAN

use strict;
use warnings;

use B                   (); # nasty stuff, all nasty stuff
use Carp                (); # errors and stuff
use Sub::Util           (); # handling some sub stuff
use Sub::Metadata       (); # handling other sub stuff
use Symbol              (); # creating the occasional symbol
use Scalar::Util        (); # I think I use blessed somewhere in here ...
use Devel::OverloadInfo (); # Sometimes I need to know about overloading
use Devel::Hook         (); # for scheduling UNITCHECK blocks ...

our $VERSION   = '0.14';
our $AUTHORITY = 'cpan:STEVAN';

## ------------------------------------------------------------------
## Basic Glob access
## ------------------------------------------------------------------

sub IS_VALID_MODULE_NAME {
    my ($name) = @_;

lib/MOP/Internal/Util.pm  view on Meta::CPAN

        # passed this in, but it is easy to get in
        # XS, and so we can punt that down the road
        # for the time being
        my $pkg = B::svref_2object( $stash )->NAME;
        *{ $pkg . '::' . $name } = $value_ref;
    }
    return;
}

## ------------------------------------------------------------------
## UNITCHECK hook
## ------------------------------------------------------------------

sub ADD_UNITCHECK_HOOK {
    my ($cv) = @_;
    Carp::confess('[ARGS] You must specify a CODE reference')
        unless $cv;
    Carp::confess('[ARGS] You must specify a CODE reference')
        unless $cv && ref $cv eq 'CODE';
    Devel::Hook->push_UNITCHECK_hook( $cv );
}

## ------------------------------------------------------------------
## CV/Glob introspection
## ------------------------------------------------------------------

sub CAN_COERCE_TO_CODE_REF {
    my ($object) = @_;
    return 0 unless $object && Scalar::Util::blessed( $object );
    # might be just a blessed CODE ref ...

lib/MOP/Util.pm  view on Meta::CPAN

            $meta->alias_slot( $slot_name, $slot->initializer )
                unless $meta->has_slot( $slot_name )
                    || $meta->has_slot_alias( $slot_name );
        }
    }

    # nothing to return ...
    return;
}

sub defer_until_UNITCHECK {
    my ($cb) = @_;

    MOP::Internal::Util::ADD_UNITCHECK_HOOK( $cb );
    return;
}

1;

__END__

=pod

=head1 NAME

lib/MOP/Util.pm  view on Meta::CPAN

=item C<inherit_slots( $meta )>

This will look to see if the C<$meta> object is a L<MOP::Class>
instance and if so, will then loop through the direct superclasses
(thouse in the C<@ISA> array of C<$meta>) and alias all the slots
into the C<$meta> namespace.

Note, if this is called more than once, the results are undefined.

=item C<defer_until_UNITCHECK( $cb )>

Given a B<CODE> reference, this will defer the execution
of that C<$cb> until the next available B<UNITCHECK> phase.

Note, it is not receommended to heavily abuse closures here, it
might get messy, might not, better to keep it clean and just not
go there.

=back

=head1 AUTHOR

Stevan Little <stevan@cpan.org>

t/001-examples/007-currency.t  view on Meta::CPAN

        my ($self, $other) = @_;
        $self->greater_than($other) || $self->equal_to($other);
    }

    sub less_than_or_equal_to {
        my ($self, $other) = @_;
        $self->less_than($other) || $self->equal_to($other);
    }

    BEGIN {
        MOP::Util::defer_until_UNITCHECK(sub {
            MOP::Util::compose_roles( MOP::Util::get_meta( __PACKAGE__ ) )
        })
    }

    package Printable;
    use strict;
    use warnings;

    sub to_string;

t/001-examples/007-currency.t  view on Meta::CPAN

        my ($self, $other) = @_;
        $self->{amount} <=> $other->{amount};
    }

    sub to_string {
        my ($self) = @_;
        sprintf '$%0.2f USD' => $self->{amount};
    }

    BEGIN {
        MOP::Util::defer_until_UNITCHECK(sub {
            MOP::Util::compose_roles( MOP::Util::get_meta( __PACKAGE__ ) )
        })
    }
}

my $Eq         = MOP::Role->new( name => 'Eq' );
my $Comparable = MOP::Role->new( name => 'Comparable');
my $USCurrency = MOP::Class->new( name => 'US::Currency');

ok($Comparable->does_role( 'Eq' ), '... Comparable does the Eq role');

t/010-role/010-composition/001-basic.t  view on Meta::CPAN

    sub bar { 'Bar::bar' }

    package FooBar;
    use strict;
    use warnings;

    our @DOES; BEGIN { @DOES = ('Foo', 'Bar') }

    BEGIN {
        MOP::Util::defer_until_UNITCHECK(sub {
            MOP::Util::compose_roles( MOP::Util::get_meta( __PACKAGE__ ) )
        })
    }
}

subtest '... testing sub-roles' => sub {
    my $Foo = MOP::Role->new( name => 'Foo' );
    isa_ok($Foo, 'MOP::Role');

    ok($Foo->has_method('foo'), '... Foo has the foo method');

t/010-role/010-composition/002-basic.t  view on Meta::CPAN

    package Bar;
    use strict;
    use warnings;

    our @DOES; BEGIN { @DOES = ('Foo') }

    sub bar { 'Bar::bar' }

    BEGIN {
        MOP::Util::defer_until_UNITCHECK(sub {
            MOP::Util::compose_roles( MOP::Util::get_meta( __PACKAGE__ ) )
        })
    }

    package FooBar;
    use strict;
    use warnings;

    our @DOES; BEGIN { @DOES = ('Bar') }

    BEGIN {
        MOP::Util::defer_until_UNITCHECK(sub {
            MOP::Util::compose_roles( MOP::Util::get_meta( __PACKAGE__ ) )
        })
    }
}

subtest '... testing sub-roles' => sub {
    my $Foo = MOP::Role->new( name => 'Foo' );
    isa_ok($Foo, 'MOP::Role');

    ok($Foo->has_method('foo'), '... Foo has the foo method');