Attributes I<are not> methods, but defining them causes various
accessor methods to be created. At a minimum, a normal attribute will
-always have a reader accessor method. Many attributes also other
-methods such as a writer method, clearer method, and predicate method
+always have a reader accessor method. Many attributes also have other
+methods, such as a writer method, clearer method, and predicate method
("has it been set?").
An attribute may also define B<delegations>, which will create
on what Perl provides, such as C<Str>, C<Num>, C<Bool>, C<HashRef>, etc.
In addition, every class name in your application can also be used as
-a type name. We saw an example using C<DateTime> earlier.
+a type name.
Finally, you can define your own types, either as subtypes or entirely
new types, with their own constraints. For example, you could define a
my $meta = User->meta();
- for my $attribute ( $meta->compute_all_applicable_attributes ) {
+ for my $attribute ( $meta->get_all_attributes ) {
print $attribute->name(), "\n";
if ( $attribute->has_type_constraint ) {
}
}
- for my $method ( $meta->compute_all_applicable_methods ) {
+ for my $method ( $meta->get_all_methods ) {
print $method->name, "\n";
}
So you're sold on Moose. Time to learn how to really use it.
-If you want to see how Moose would translate directly old school Perl
-5 OO code, check out L<Moose::Unsweetened>. This might be helpful for
-quickly wrapping your brain around some aspects of "the Moose way".
+If you want to see how Moose would translate directly into old school
+Perl 5 OO code, check out L<Moose::Unsweetened>. This might be
+helpful for quickly wrapping your brain around some aspects of "the
+Moose way".
Obviously, the next thing to read is the rest of the L<Moose::Manual>.
use Scalar::Util 'blessed', 'weaken';
use overload ();
-our $VERSION = '0.72_01';
+our $VERSION = '0.73';
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Method::Accessor;
my ( @init, @non_init );
- foreach my $attr ( grep { $_->has_value($self) } Class::MOP::class_of($self)->compute_all_applicable_attributes ) {
- foreach my $attr ( grep { $_->has_value($self) } $self->meta->get_all_attributes ) {
++ foreach my $attr ( grep { $_->has_value($self) } Class::MOP::class_of($self)->get_all_attributes ) {
push @{ $attr->has_init_arg ? \@init : \@non_init }, $attr;
}
return unless $value_is_set;
- if ($self->has_type_constraint) {
- my $type_constraint = $self->type_constraint;
- if ($self->should_coerce && $type_constraint->has_coercion) {
- $val = $type_constraint->coerce($val);
- }
- $self->verify_against_type_constraint($val, instance => $instance);
- }
+ $val = $self->_coerce_and_verify( $val, $instance );
$self->set_initial_value($instance, $val);
$meta_instance->weaken_slot_value($instance, $self->name)
}
my $callback = sub {
- my $val = shift;
- if ($type_constraint) {
- $val = $type_constraint->coerce($val)
- if $can_coerce;
- $self->verify_against_type_constraint($val, object => $instance);
- }
+ my $val = $self->_coerce_and_verify( shift, $instance );;
+
$meta_instance->set_slot_value($instance, $slot_name, $val);
};
$self->throw_error("Attribute ($attr_name) is required", object => $instance);
}
- if ($self->has_type_constraint) {
-
- my $type_constraint = $self->type_constraint;
-
- if ($self->should_coerce) {
- $value = $type_constraint->coerce($value);
- }
- $type_constraint->_compiled_type_constraint->($value)
- || $self->throw_error("Attribute ("
- . $self->name
- . ") does not pass the type constraint because "
- . $type_constraint->get_message($value), object => $instance, data => $value);
- }
+ $value = $self->_coerce_and_verify( $value, $instance );
my $meta_instance = Class::MOP::Class->initialize(blessed($instance))
->get_meta_instance;
} elsif ( $self->has_builder ) {
$value = $self->_call_builder($instance);
}
- if ($self->has_type_constraint) {
- my $type_constraint = $self->type_constraint;
- $value = $type_constraint->coerce($value)
- if ($self->should_coerce);
- $self->verify_against_type_constraint($value);
- }
+
+ $value = $self->_coerce_and_verify( $value, $instance );
+
$self->set_initial_value($instance, $value);
}
}
}
}
else {
- Class::MOP::load_class($handles)
- unless Class::MOP::is_class_loaded($handles);
-
- my $role_meta = eval { $handles->meta };
- if ($@) {
- $self->throw_error("Unable to canonicalize the 'handles' option with $handles because : $@", data => $handles, error => $@);
- }
+ my $role_meta = Class::MOP::load_class($handles);
(blessed $role_meta && $role_meta->isa('Moose::Meta::Role'))
- || $self->throw_error("Unable to canonicalize the 'handles' option with $handles because ->meta is not a Moose::Meta::Role", data => $handles);
+ || $self->throw_error("Unable to canonicalize the 'handles' option with $handles because its metaclass is not a Moose::Meta::Role", data => $handles);
return map { $_ => $_ } (
$role_meta->get_method_list,
sub _find_delegate_metaclass {
my $self = shift;
if (my $class = $self->_isa_metadata) {
- # if the class does have
- # a meta method, use it
- return $class->meta if $class->can('meta');
- # otherwise we might be
- # dealing with a non-Moose
- # class, and need to make
- # our own metaclass
+ # we might be dealing with a non-Moose class,
+ # and need to make our own metaclass. if there's
+ # already a metaclass, it will be returned
return Moose::Meta::Class->initialize($class);
}
elsif (my $role = $self->_does_metadata) {
- # our role will always have
- # a meta method
- return $role->meta;
+ return Class::MOP::class_of($role);
}
else {
$self->throw_error("Cannot find delegate metaclass for attribute " . $self->name);
);
}
+sub _coerce_and_verify {
+ my $self = shift;
+ my $val = shift;
+ my $instance = shift;
+
+ return $val unless $self->has_type_constraint;
+
+ my $type_constraint = $self->type_constraint;
+ if ($self->should_coerce && $type_constraint->has_coercion) {
+ $val = $type_constraint->coerce($val);
+ }
+
+ $self->verify_against_type_constraint($val, instance => $instance);
+
+ return $val;
+}
+
sub verify_against_type_constraint {
my $self = shift;
my $val = shift;
use List::MoreUtils qw( any all uniq );
use Scalar::Util 'weaken', 'blessed';
-our $VERSION = '0.72_01';
+our $VERSION = '0.73';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
return $class;
}
- sub check_metaclass_compatibility {
+ sub _check_metaclass_compatibility {
my $self = shift;
if ( my @supers = $self->superclasses ) {
$self->_fix_metaclass_incompatibility(@supers);
}
- $self->SUPER::check_metaclass_compatibility(@_);
+ $self->SUPER::_check_metaclass_compatibility(@_);
}
my %ANON_CLASSES;
sub does_role {
my ($self, $role_name) = @_;
+
(defined $role_name)
|| $self->throw_error("You must supply a role name to look for");
+
foreach my $class ($self->class_precedence_list) {
- next unless $class->can('meta') && $class->meta->can('roles');
- foreach my $role (@{$class->meta->roles}) {
+ my $meta = Class::MOP::class_of($class);
+ # when a Moose metaclass is itself extended with a role,
+ # this check needs to be done since some items in the
+ # class_precedence_list might in fact be Class::MOP
+ # based still.
+ next unless $meta && $meta->can('roles');
+ foreach my $role (@{$meta->roles}) {
return 1 if $role->does_role($role_name);
}
}
sub excludes_role {
my ($self, $role_name) = @_;
+
(defined $role_name)
|| $self->throw_error("You must supply a role name to look for");
+
foreach my $class ($self->class_precedence_list) {
- next unless $class->can('meta');
- # NOTE:
- # in the pretty rare instance when a Moose metaclass
- # is itself extended with a role, this check needs to
- # be done since some items in the class_precedence_list
- # might in fact be Class::MOP based still.
- next unless $class->meta->can('roles');
- foreach my $role (@{$class->meta->roles}) {
+ my $meta = Class::MOP::class_of($class);
+ # when a Moose metaclass is itself extended with a role,
+ # this check needs to be done since some items in the
+ # class_precedence_list might in fact be Class::MOP
+ # based still.
+ next unless $meta && $meta->can('roles');
+ foreach my $role (@{$meta->roles}) {
return 1 if $role->excludes_role($role_name);
}
}
my $params = @_ == 1 ? $_[0] : {@_};
my $self = $class->SUPER::new_object($params);
- foreach my $attr ( $class->compute_all_applicable_attributes() ) {
+ foreach my $attr ( $class->get_all_attributes() ) {
next unless $attr->can('has_trigger') && $attr->has_trigger;
? $attr->get_read_method_ref->($self)
: $params->{$init_arg}
),
- $attr
);
}
return $self;
}
- sub construct_instance {
+ sub _construct_instance {
my $class = shift;
my $params = @_ == 1 ? $_[0] : {@_};
my $meta_instance = $class->get_meta_instance;
# but this is foreign inheritance, so we might
# have to kludge it in the end.
my $instance = $params->{'__INSTANCE__'} || $meta_instance->create_instance();
- foreach my $attr ($class->compute_all_applicable_attributes()) {
+ foreach my $attr ($class->get_all_attributes()) {
$attr->initialize_instance_slot($meta_instance, $instance, $params);
}
return $instance;
sub _reconcile_with_superclass_meta {
my ($self, $super) = @_;
- my $super_meta = $super->meta;
+ my $super_meta = Class::MOP::class_of($super);
my $super_meta_name
= $super_meta->is_immutable
sub _reconcile_role_differences {
my ($self, $super_meta) = @_;
- my $self_meta = $self->meta;
+ my $self_meta = Class::MOP::class_of($self);
my %roles;
use strict;
use warnings;
-our $VERSION = '0.72_01';
+our $VERSION = '0.73';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
or $self->throw_error("Could not create writer for '${\$self->associated_attribute->name}' because $@ \n code: $code", error => $@, data => $code );
}
- sub generate_accessor_method_inline {
+ sub _generate_accessor_method_inline {
my $self = $_[0];
my $attr = $self->associated_attribute;
my $attr_name = $attr->name;
. 'if (scalar(@_) >= 2) {' . "\n"
. $self->_inline_copy_value . "\n"
. $self->_inline_check_required . "\n"
- . $self->_inline_check_coercion . "\n"
+ . $self->_inline_check_coercion($value_name) . "\n"
. $self->_inline_check_constraint($value_name) . "\n"
. $self->_inline_store($inv, $value_name) . "\n"
. $self->_inline_trigger($inv, $value_name) . "\n"
. ' }');
}
- sub generate_writer_method_inline {
+ sub _generate_writer_method_inline {
my $self = $_[0];
my $attr = $self->associated_attribute;
my $attr_name = $attr->name;
. $self->_inline_pre_body(@_)
. $self->_inline_copy_value
. $self->_inline_check_required
- . $self->_inline_check_coercion
+ . $self->_inline_check_coercion($value_name)
. $self->_inline_check_constraint($value_name)
. $self->_inline_store($inv, $value_name)
. $self->_inline_post_body(@_)
. ' }');
}
- sub generate_reader_method_inline {
+ sub _generate_reader_method_inline {
my $self = $_[0];
my $attr = $self->associated_attribute;
my $attr_name = $attr->name;
return $attr->should_coerce;
}
- sub generate_reader_method { shift->generate_reader_method_inline(@_) }
- sub generate_writer_method { shift->generate_writer_method_inline(@_) }
- sub generate_accessor_method { shift->generate_accessor_method_inline(@_) }
- sub generate_predicate_method { shift->generate_predicate_method_inline(@_) }
- sub generate_clearer_method { shift->generate_clearer_method_inline(@_) }
+ sub _generate_reader_method { shift->_generate_reader_method_inline(@_) }
+ sub _generate_writer_method { shift->_generate_writer_method_inline(@_) }
+ sub _generate_accessor_method { shift->_generate_accessor_method_inline(@_) }
+ sub _generate_predicate_method { shift->_generate_predicate_method_inline(@_) }
+ sub _generate_clearer_method { shift->_generate_clearer_method_inline(@_) }
sub _inline_pre_body { '' }
sub _inline_post_body { '' }
}
sub _inline_check_coercion {
- my $attr = (shift)->associated_attribute;
+ my ($self, $value) = @_;
+
+ my $attr = $self->associated_attribute;
return '' unless $attr->should_coerce;
- return '$val = $attr->type_constraint->coerce($_[1]);'
+ return "$value = \$attr->type_constraint->coerce($value);";
}
sub _inline_check_required {
' ' . $self->_inline_throw_error(q{sprintf "%s does not support builder method '%s' for attribute '%s'", ref(} . $instance . ') || '.$instance.', $attr->builder, $attr->name') .
';'. "\n }";
}
- $code .= ' $default = $type_constraint_obj->coerce($default);'."\n" if $attr->should_coerce;
- $code .= ' ($type_constraint->($default))' .
- ' || ' . $self->_inline_throw_error('"Attribute (" . $attr_name . ") does not pass the type constraint ("' .
- ' . $type_constraint_name . ") with " . (defined($default) ? overload::StrVal($default) : "undef")' ) . ';'
- . "\n";
+ $code .= $self->_inline_check_coercion('$default') . "\n";
+ $code .= $self->_inline_check_constraint('$default') . "\n";
$code .= ' ' . $self->_inline_init_slot($attr, $instance, $slot_access, '$default') . "\n";
}
else {
use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
-our $VERSION = '0.72_01';
+our $VERSION = '0.73';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Moose::Meta::Method',
|| $class->throw_error("You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT");
my $self = bless {
'body' => undef,
'package_name' => $options{package_name},
'name' => $options{name},
-- # specific to this subclass
'options' => $options{options},
-- 'meta_instance' => $meta->get_meta_instance,
- 'attributes' => [ $meta->compute_all_applicable_attributes ],
- # ...
- 'attributes' => [ $meta->get_all_attributes ],
- # ...
'associated_metaclass' => $meta,
} => $class;
# needed
weaken($self->{'associated_metaclass'});
- $self->initialize_body;
+ $self->_initialize_body;
return $self;
}
return 'Moose::Object';
}
--## accessors
--
--sub meta_instance { (shift)->{'meta_instance'} }
--sub attributes { (shift)->{'attributes'} }
--
## method
- sub initialize_body {
-sub _generate_params {
- my ($self, $var, $class_var) = @_;
- "my $var = " . $self->_generate_BUILDARGS($class_var, '@_') . ";\n";
-}
-
-sub _generate_instance {
- my ($self, $var, $class_var) = @_;
- "my $var = " . $self->meta_instance->inline_create_instance($class_var)
- . ";\n";
-}
-
-sub _generate_slot_initializers {
- my ($self) = @_;
- return (join ";\n" => map {
- $self->_generate_slot_initializer($_)
- } 0 .. (@{$self->attributes} - 1)) . ";\n";
-}
-
+ sub _initialize_body {
my $self = shift;
# TODO:
# the %options should also include a both
# because the inlined code is using the index of the attributes
# to determine where to find the type constraint
-- my $attrs = $self->attributes;
++ my $attrs = $self->_attributes;
my @type_constraints = map {
$_->can('type_constraint') ? $_->type_constraint : undef
$self->{'body'} = $code;
}
+sub _generate_params {
+ my ( $self, $var, $class_var ) = @_;
+ "my $var = " . $self->_generate_BUILDARGS( $class_var, '@_' ) . ";\n";
+}
+
+sub _generate_instance {
+ my ( $self, $var, $class_var ) = @_;
+ "my $var = "
- . $self->meta_instance->inline_create_instance($class_var) . ";\n";
++ . $self->_meta_instance->inline_create_instance($class_var) . ";\n";
+}
+
+sub _generate_slot_initializers {
+ my ($self) = @_;
+ return (join ";\n" => map {
+ $self->_generate_slot_initializer($_)
- } 0 .. (@{$self->attributes} - 1)) . ";\n";
++ } 0 .. (@{$self->_attributes} - 1)) . ";\n";
+}
+
sub _generate_BUILDARGS {
my ( $self, $class, $args ) = @_;
sub _generate_triggers {
my $self = shift;
my @trigger_calls;
-- foreach my $i ( 0 .. $#{ $self->attributes } ) {
-- my $attr = $self->attributes->[$i];
++ foreach my $i ( 0 .. $#{ $self->_attributes } ) {
++ my $attr = $self->_attributes->[$i];
next unless $attr->can('has_trigger') && $attr->has_trigger;
. $i
. ']->trigger->('
. '$instance, '
-- . $self->meta_instance->inline_get_slot_value(
++ . $self->_meta_instance->inline_get_slot_value(
'$instance',
$attr->name,
)
. ', '
- . '$attrs->['
- . $i . ']' . ');' . "\n}";
+ . ');' . "\n}";
}
return join ";\n" => @trigger_calls;
my $self = shift;
my $index = shift;
-- my $attr = $self->attributes->[$index];
++ my $attr = $self->_attributes->[$index];
my @source = ('## ' . $attr->name);
}
else {
$source = (
-- $self->meta_instance->inline_set_slot_value(
++ $self->_meta_instance->inline_set_slot_value(
'$instance',
$attr->name,
$value
if ($is_moose && $attr->is_weak_ref) {
$source .= (
"\n" .
-- $self->meta_instance->inline_weaken_slot_value(
++ $self->_meta_instance->inline_weaken_slot_value(
'$instance',
$attr->name
) .
use Scalar::Util 'blessed';
use Carp 'confess';
-our $VERSION = '0.72_01';
+our $VERSION = '0.73';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
## ------------------------------------------------------------------
## subroles
-__PACKAGE__->meta->add_attribute('roles' => (
+$META->add_attribute('roles' => (
reader => 'get_roles',
default => sub { [] }
));
$map->{$symbol}->body == $code;
my ($pkg, $name) = Class::MOP::get_code_info($code);
+ my $meta = Class::MOP::class_of($pkg);
- if ($pkg->can('meta')
- # NOTE:
- # we don't know what ->meta we are calling
- # here, so we need to be careful cause it
- # just might blow up at us, or just complain
- # loudly (in the case of Curses.pm) so we
- # just be a little overly cautious here.
- # - SL
- && eval { no warnings; blessed($pkg->meta) } # FIXME calls meta
- && $pkg->meta->isa('Moose::Meta::Role')) {
- my $role = $pkg->meta->name;
+ if ($meta && $meta->isa('Moose::Meta::Role')) {
+ my $role = $meta->name;
next unless $self->does_role($role);
}
else {
my (@roles, %role_params);
while (@role_specs) {
my ($role, $params) = @{ splice @role_specs, 0, 1 };
- push @roles => $role->meta;
+ push @roles => Class::MOP::class_of($role);
next unless defined $params;
$role_params{$role} = $params;
}
|| confess "You must pass a HASH ref of methods"
if exists $options{methods};
- $role->SUPER::create(%options);
-
my (%initialize_options) = %options;
delete @initialize_options{qw(
package
my $meta = $role->initialize( $package_name => %initialize_options );
+ $meta->_instantiate_module( $options{version}, $options{authority} );
+
# FIXME totally lame
$meta->add_method('meta' => sub {
$role->initialize(ref($_[0]) || $_[0]);
use Scalar::Util 'blessed';
use Class::MOP 0.60;
-our $VERSION = '0.72_01';
+our $VERSION = '0.73';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
## some utils for the utils ...
-sub find_meta {
- return unless $_[0];
- return Class::MOP::get_metaclass_by_name(blessed($_[0]) || $_[0]);
-}
+sub find_meta { Class::MOP::class_of(@_) }
## the functions ...
my $roles = Data::OptList::mkopt( [@_] );
- my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) );
-
- foreach my $role_spec (@$roles) {
- Class::MOP::load_class( $role_spec->[0] );
- }
-
foreach my $role (@$roles) {
- unless ( $role->[0]->can('meta')
- && $role->[0]->meta->isa('Moose::Meta::Role') ) {
+ my $meta = Class::MOP::load_class( $role->[0] );
+ unless ($meta->isa('Moose::Meta::Role') ) {
require Moose;
Moose->throw_error( "You can only consume roles, "
. $role->[0]
}
}
+ my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) );
+
if ( scalar @$roles == 1 ) {
my ( $role, $params ) = @{ $roles->[0] };
- $role->meta->apply( $meta, ( defined $params ? %$params : () ) );
+ my $role_meta = Class::MOP::class_of($role);
+ $role_meta->apply( $meta, ( defined $params ? %$params : () ) );
}
else {
Moose::Meta::Role->combine( @$roles )->apply($meta);
return +{
map { $_->name => $_->get_value($instance) }
grep { $_->has_value($instance) }
- $class->compute_all_applicable_attributes
+ $class->get_all_attributes
};
}
map { $_->init_arg => $_->get_value($instance) }
grep { $_->has_value($instance) }
grep { defined($_->init_arg) }
- $class->compute_all_applicable_attributes
+ $class->get_all_attributes
};
}
projects / gitmo/Moose.git / commitdiff