Also see Moose::Manual::Delta for more details of, and workarounds
for, noteworthy changes.
-0.84
+0.85
* Moose::Meta::Attribute
- - When adding an attribute to a metaclass, if the attribute has no
- associated methods, it will give a deprecation warning. (hdp)
+ - The warning for 'no associated methods' is now split out into the
+ check_associated_methods method, so that extensions can safely call
+ 'after install_accessors => ...'. (hdp)
+ - Move currying syntax for delegation in from AttributeHelpers. (hdp)
+
+0.84 Fri, Jun 26, 2009
+ * Moose::Role
+ - has now sets definition_context for attributes defined in
+ roles. (doy)
+
+ * Moose::Meta::Attribute
+ - When adding an attribute to a metaclass, if the attribute has
+ no associated methods, it will give a deprecation
+ warning. (hdp)
- Methods generated by delegation were not being added to
associated_methods. (hdp)
- - Move currying syntax for delegation in from AttributeHelpers. (hdp)
+ - Attribute accessors (reader, writer, accessor, predicate,
+ clearer) now warn if they overwrite an existing method. (doy)
+ - Attribute constructors now warn very noisily about unknown (or
+ mispelled) arguments
+
+ * Moose::Util::TypeConstraints
+ - Deprecated the totally useless Role type name, which just
+ checked if $object->can('does'). Note that this is _not_ the
+ same as a type created by calling role_type('RoleName').
* Moose::Util::TypeConstraints
* Moose::Meta::TypeConstraint::DuckType
- Reify duck type from a regular subtype into an actual class
(Sartak)
+ - Document this because Sartak did all my work for me
+ (perigrin)
* Moose::Meta::Attribute
- Allow Moose::Meta::TypeConstraint::DuckType in handles, since
it is just a list of methods (Sartak)
+ * Moose::Meta::Role
+ - The get_*_method_modifiers methods would die if the role had
+ no modifiers of the given type (Robert Buels).
+
0.83 Tue, Jun 23, 2009
* Moose::Meta::Class
- Fix _construct_instance not setting the special __MOP__ object
- added all the meta classes to the immutable list and
set it to inline the accessors
- fix import to allow Sub::Exporter like { into => }
- and { into_level => } (perigrin)
+ and { into_level => } (perigrin)
- exposed and documented init_meta() to allow better
- embedding and extending of Moose (perigrin)
+ embedding and extending of Moose (perigrin)
- * t/
- - complete re-organization of the test suite
- - added some new tests as well
- - finally re-enabled the Moose::POOP test since
- the new version of DBM::Deep now works again
- (thanks rob)
+ * t/
+ - complete re-organization of the test suite
+ - added some new tests as well
+ - finally re-enabled the Moose::POOP test since
+ the new version of DBM::Deep now works again
+ (thanks rob)
* Moose::Meta::Class
- fixed very odd and very nasty recursion bug with
- Type constraints now survive runtime reloading
- added test for this
- * Moose::Meta::Class
- - fixed the way attribute defaults are handled
- during instance construction (bug found by chansen)
+ * Moose::Meta::Class
+ - fixed the way attribute defaults are handled
+ during instance construction (bug found by chansen)
* Moose::Meta::Attribute
- read-only attributes now actually enforce their
* Moose::Meta::TypeConstraint
* Moose::Meta::TypeCoercion
- - type constraints and coercions are now
- full fledges meta-objects
+ - type constraints and coercions are now
+ full fledges meta-objects
0.01 Wed. March 15, 2006
- Moooooooooooooooooose!!!
requires 'Carp';
requires 'Class::MOP' => '0.88';
requires 'List::MoreUtils' => '0.12';
-requires 'Sub::Exporter' => '0.972';
+requires 'Sub::Exporter' => '0.980';
requires 'Task::Weaken' => '0';
requires 'Data::OptList' => '0';
requires 'Sub::Name' => '0';
-Moose version 0.83
+Moose version 0.84
===========================
See the individual module documentation for more information
use 5.008;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Util::TypeConstraints;
use Moose::Util ();
-sub _caller_info {
- my $level = @_ ? ($_[0] + 1) : 2;
- my %info;
- @info{qw(package file line)} = caller($level);
- return \%info;
-}
-
sub throw_error {
# FIXME This
shift;
Moose->throw_error('Usage: has \'name\' => ( key => value, ... )')
if @_ % 2 == 1;
- my %options = ( definition_context => _caller_info(), @_ );
+ my %options = ( definition_context => Moose::Util::_caller_info(), @_ );
my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];
Class::MOP::Class->initialize($class)->add_attribute( $_, %options ) for @$attrs;
}
either in the constructor, or using the writer. Default and built values will
B<not> cause the trigger to be fired.
-=item I<handles =E<gt> ARRAY | HASH | REGEXP | ROLE | CODE>
+=item I<handles =E<gt> ARRAY | HASH | REGEXP | ROLE | DUCKTYPE | CODE>
The I<handles> option provides Moose classes with automated delegation features.
This is a pretty complex and powerful option. It accepts many different option
that this does B<not> include any method modifiers or generated attribute
methods (which is consistent with role composition).
+=item C<DUCKTYPE>
+
+With the duck type option, you pass a duck type object whose "interface" then
+becomes the list of methods to handle. The "interface" can be defined as; the
+list of methods passed to C<duck_type> to create a duck type object. For more
+information on C<duck_type> please check
+L<Moose::Util::TypeConstraint|Moose::Util::TypeConstraint>.
+
=item C<CODE>
This is the option to use when you really want to do something funky. You should
use strict;
use warnings;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Class::MOP;
use List::MoreUtils qw( first_index uniq );
use Moose::Util::MetaRole;
-use Sub::Exporter;
+use Sub::Exporter 0.980;
use Sub::Name qw(subname);
my %EXPORT_SPEC;
my $export_recorder = {};
- my ( $exports, $is_removable )
+ my ( $exports, $is_removable, $groups )
= $class->_make_sub_exporter_params(
[ @exports_from, $exporting_package ], $export_recorder );
my $exporter = Sub::Exporter::build_exporter(
{
exports => $exports,
- groups => { default => [':all'] }
+ groups => { default => [':all'], %$groups }
}
);
my $packages = shift;
my $export_recorder = shift;
+ my %groups;
my %exports;
my %is_removable;
my $args = $EXPORT_SPEC{$package}
or die "The $package package does not use Moose::Exporter\n";
+ # one group for each 'also' package
+ $groups{$package} = [
+ @{ $args->{with_caller} || [] },
+ @{ $args->{with_meta} || [] },
+ @{ $args->{as_is} || [] },
+ map ":$_",
+ keys %{ $args->{groups} || {} }
+ ];
+
for my $name ( @{ $args->{with_caller} } ) {
my $sub = do {
no strict 'refs';
$is_removable{$name} = 1;
}
+ for my $name ( @{ $args->{with_meta} } ) {
+ my $sub = do {
+ no strict 'refs';
+ \&{ $package . '::' . $name };
+ };
+
+ my $fq_name = $package . '::' . $name;
+
+ $exports{$name} = $class->_make_wrapped_sub_with_meta(
+ $fq_name,
+ $sub,
+ $export_recorder,
+ );
+
+ $is_removable{$name} = 1;
+ }
+
for my $name ( @{ $args->{as_is} } ) {
my $sub;
$exports{$name} = sub {$sub};
}
+
+ for my $name ( keys %{ $args->{groups} } ) {
+ my $group = $args->{groups}{$name};
+
+ if (ref $group eq 'CODE') {
+ $groups{$name} = $class->_make_wrapped_group(
+ $package,
+ $group,
+ $export_recorder,
+ \%exports,
+ \%is_removable
+ );
+ }
+ elsif (ref $group eq 'ARRAY') {
+ $groups{$name} = $group;
+ }
+ }
}
- return ( \%exports, \%is_removable );
+ return ( \%exports, \%is_removable, \%groups );
}
our $CALLER;
};
}
+sub _make_wrapped_sub_with_meta {
+ my $self = shift;
+ my $fq_name = shift;
+ my $sub = shift;
+ my $export_recorder = shift;
+
+ return sub {
+ my $caller = $CALLER;
+
+ my $wrapper = $self->_late_curry_wrapper($sub, $fq_name,
+ sub { Class::MOP::class_of(shift) } => $caller);
+
+ my $sub = subname($fq_name => $wrapper);
+
+ $export_recorder->{$sub} = 1;
+
+ return $sub;
+ };
+}
+
+sub _make_wrapped_group {
+ my $class = shift;
+ my $package = shift; # package calling use Moose::Exporter
+ my $sub = shift;
+ my $export_recorder = shift;
+ my $keywords = shift;
+ my $is_removable = shift;
+
+ return sub {
+ my $caller = $CALLER; # package calling use PackageUsingMooseExporter -group => {args}
+
+ # there are plenty of ways to deal with telling the code which
+ # package it lives in. the last arg (collector hashref) is
+ # otherwise unused, so we'll stick the original package in
+ # there and act like 'with_caller' by putting the calling
+ # package name as the first arg
+ $_[0] = $caller;
+ $_[3]{from} = $package;
+
+ my $named_code = $sub->(@_);
+ $named_code ||= { };
+
+ # send invalid return value error up to Sub::Exporter
+ unless (ref $named_code eq 'HASH') {
+ return $named_code;
+ }
+
+ for my $name (keys %$named_code) {
+ my $code = $named_code->{$name};
+
+ my $fq_name = $package . '::' . $name;
+ my $wrapper = $class->_curry_wrapper(
+ $code,
+ $fq_name,
+ $caller
+ );
+
+ my $sub = subname( $fq_name => $wrapper );
+ $named_code->{$name} = $sub;
+
+ # mark each coderef as ours
+ $keywords->{$name} = 1;
+ $is_removable->{$name} = 1;
+ $export_recorder->{$sub} = 1;
+ }
+
+ return $named_code;
+ };
+}
+
sub _curry_wrapper {
my $class = shift;
my $sub = shift;
return $wrapper;
}
+sub _late_curry_wrapper {
+ my $class = shift;
+ my $sub = shift;
+ my $fq_name = shift;
+ my $extra = shift;
+ my @ex_args = @_;
+
+ my $wrapper = sub {
+ # resolve curried arguments at runtime via this closure
+ my @curry = ( $extra->( @ex_args ) );
+ return $sub->(@curry, @_);
+ };
+
+ if (my $proto = prototype $sub) {
+ # XXX - Perl's prototype sucks. Use & to make set_prototype
+ # ignore the fact that we're passing "private variables"
+ &Scalar::Util::set_prototype($wrapper, $proto);
+ }
+ return $wrapper;
+}
+
sub _make_import_sub {
shift;
my $exporting_package = shift;
it documented here, or think we missed an important feature, please
send us a patch.
+=head1 Version 0.84
+
+The C<Role> type has been deprecated. On its own, it was useless,
+since it just checked C<< $object->can('does') >>. If you were using
+it as a parent type, just call C<role_type('Role::Name')> to create an
+appropriate type instead.
+
=head1 Version 0.78
C<use Moose::Exporter;> now imports C<strict> and C<warnings> into packages
use Scalar::Util 'blessed', 'weaken';
use overload ();
-our $VERSION = '0.83';
+our $VERSION = '0.84';
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Method::Accessor;
sub new {
my ($class, $name, %options) = @_;
$class->_process_options($name, \%options) unless $options{__hack_no_process_options}; # used from clone()... YECHKKK FIXME ICKY YUCK GROSS
+
+ delete $options{__hack_no_process_options};
+
+ my %attrs =
+ ( map { $_ => 1 }
+ grep { defined }
+ map { $_->init_arg() }
+ $class->meta()->get_all_attributes()
+ );
+
+ my @bad = sort grep { ! $attrs{$_} } keys %options;
+
+ if (@bad)
+ {
+ Carp::cluck "Found unknown argument(s) passed to '$name' attribute constructor in '$class': @bad";
+ }
+
return $class->SUPER::new($name, %options);
}
sub interpolate_class_and_new {
- my ($class, $name, @args) = @_;
+ my ($class, $name, %args) = @_;
- my ( $new_class, @traits ) = $class->interpolate_class(@args);
+ my ( $new_class, @traits ) = $class->interpolate_class(\%args);
- $new_class->new($name, @args, ( scalar(@traits) ? ( traits => \@traits ) : () ) );
+ $new_class->new($name, %args, ( scalar(@traits) ? ( traits => \@traits ) : () ) );
}
sub interpolate_class {
- my ($class, %options) = @_;
+ my ($class, $options) = @_;
$class = ref($class) || $class;
- if ( my $metaclass_name = delete $options{metaclass} ) {
+ if ( my $metaclass_name = delete $options->{metaclass} ) {
my $new_class = Moose::Util::resolve_metaclass_alias( Attribute => $metaclass_name );
if ( $class ne $new_class ) {
if ( $new_class->can("interpolate_class") ) {
- return $new_class->interpolate_class(%options);
+ return $new_class->interpolate_class($options);
} else {
$class = $new_class;
}
my @traits;
- if (my $traits = $options{traits}) {
+ if (my $traits = $options->{traits}) {
my $i = 0;
while ($i < @$traits) {
my $trait = $traits->[$i++];
# so we can ignore it for them.
# - SL
if ($self->can('interpolate_class')) {
- ( $actual_options{metaclass}, my @traits ) = $self->interpolate_class(%options);
+ ( $actual_options{metaclass}, my @traits ) = $self->interpolate_class(\%options);
my %seen;
my @all_traits = grep { $seen{$_}++ } @{ $self->applied_traits || [] }, @traits;
sub clone {
my ( $self, %params ) = @_;
- my $class = $params{metaclass} || ref $self;
+ my $class = delete $params{metaclass} || ref $self;
my ( @init, @non_init );
my $self = shift;
$self->SUPER::install_accessors(@_);
$self->install_delegation if $self->has_handles;
+ return;
+}
+
+sub check_associated_methods {
+ my $self = shift;
unless (
@{ $self->associated_methods }
|| ($self->_is_metadata || '') eq 'bare'
) {
Carp::cluck(
- 'Attribute (' . $self->name . ') has no associated methods'
+ 'Attribute (' . $self->name . ') of class '
+ . $self->associated_class->name
+ . ' has no associated methods'
. ' (did you mean to provide an "is" argument?)'
. "\n"
)
}
- return;
+}
+
+sub _process_accessors {
+ my $self = shift;
+ my ($type, $accessor, $generate_as_inline_methods) = @_;
+ $accessor = (keys %$accessor)[0] if (ref($accessor)||'') eq 'HASH';
+ my $method = $self->associated_class->get_method($accessor);
+ if ($method && !$method->isa('Class::MOP::Method::Accessor')
+ && (!$self->definition_context
+ || $method->package_name eq $self->definition_context->{package})) {
+ Carp::cluck(
+ "You cannot overwrite a locally defined method ($accessor) with "
+ . "an accessor"
+ );
+ }
+ $self->SUPER::_process_accessors(@_);
}
sub remove_accessors {
Use 'bare' when you are deliberately not installing any methods
(accessor, reader, etc.) associated with this attribute; otherwise,
Moose will issue a deprecation warning when this attribute is added to a
-metaclass.
+metaclass. See L</check_associated_methods>.
=item * isa => $type
attribute's type constraint. If the value is not valid, it throws an
error.
+=item B<< $attr->check_associated_methods >>
+
+This method makes sure that either an explicit C<< is => 'bare' >> was passed
+to the attribute's constructor or that the attribute has at least one
+associated method (reader, writer, delegation, etc.). Otherwise, it issues a
+warning.
+
=item B<< $attr->handles >>
This returns the value of the C<handles> option passed to the
use List::MoreUtils qw( any all uniq first_index );
use Scalar::Util 'weaken', 'blessed';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
sub add_attribute {
my $self = shift;
- $self->SUPER::add_attribute(
+ my $attr =
(blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
? $_[0]
- : $self->_process_attribute(@_))
- );
+ : $self->_process_attribute(@_));
+ $self->SUPER::add_attribute($attr);
+ # it may be a Class::MOP::Attribute, theoretically, which doesn't have
+ # 'bare' and doesn't implement this method
+ if ($attr->can('check_associated_methods')) {
+ $attr->check_associated_methods;
+ }
+ return $attr;
}
sub add_override_method_modifier {
use Class::MOP;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Moose::Meta::Method',
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
# NOTE: we used to do a goto here, but the goto didn't handle
# failure correctly (it just returned nothing), so I took that
# out. However, the more I thought about it, the less I liked it
- # doing the goto, and I prefered the act of delegation being
+ # doing the goto, and I preferred the act of delegation being
# actually represented in the stack trace. - SL
# not inlining this, since it won't really speed things up at
# all... the only thing that would end up different would be
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Sub::Name 'subname';
use Devel::GlobalDestruction 'in_global_destruction';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
$META->add_method("get_${modifier_type}_method_modifiers" => sub {
my ($self, $method_name) = @_;
#return () unless exists $self->$attr_reader->{$method_name};
- @{$self->$attr_reader->{$method_name}};
+ my $mm = $self->$attr_reader->{$method_name};
+ $mm ? @$mm : ();
});
$META->add_method("has_${modifier_type}_method_modifiers" => sub {
use warnings;
use metaclass;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Role::Composite;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Util 'english_list';
use Scalar::Util 'weaken', 'blessed';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use base qw(Moose::Meta::Role::Method::Required);
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use base qw(Class::MOP::Object);
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Attribute;
use Moose::Util::TypeConstraints ();
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use base qw(Class::MOP::Object);
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
use Moose::Util::TypeConstraints ();
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Util::TypeConstraints ();
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Util::TypeConstraints ();
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use warnings;
use metaclass;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Util::TypeConstraints;
use Moose::Meta::TypeConstraint::Parameterizable;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
use Moose::Util::TypeConstraints ();
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
sub new {
my ( $class, %args ) = @_;
- $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Role');
+ $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Object');
my $self = $class->_new(\%args);
$self->_create_hand_optimized_type_constraint;
use Moose::Meta::TypeCoercion::Union;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use if ( not our $__mx_is_compiled ), 'Moose::Meta::Class';
use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Sub::Exporter;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
my $meta = Moose::Meta::Role->initialize(shift);
my $name = shift;
croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1;
- my %options = @_;
+ my %options = ( definition_context => Moose::Util::_caller_info(), @_ );
my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];
$meta->add_attribute( $_, %options ) for @$attrs;
}
use Scalar::Util 'blessed';
use Class::MOP 0.60;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
return $list;
}
+sub _caller_info {
+ my $level = @_ ? ($_[0] + 1) : 2;
+ my %info;
+ @info{qw(package file line)} = caller($level);
+ return \%info;
+}
+
1;
__END__
use strict;
use warnings;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util qw( blessed reftype );
use Moose::Exporter;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
where { blessed($_) && blessed($_) ne 'Regexp' } =>
optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Object;
+# This type is deprecated.
subtype 'Role' => as 'Object' => where { $_->can('does') } =>
optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role;
Defined
Value
Num
- Int
+ Int
Str
- ClassName
- RoleName
+ ClassName
+ RoleName
Ref
ScalarRef
ArrayRef[`a]
CodeRef
RegexpRef
GlobRef
- FileHandle
+ FileHandle
Object
- Role
B<NOTE:> Any type followed by a type parameter C<[`a]> can be
parameterized, this means you can say:
type constraint to pass.
B<NOTE:> The C<RoleName> constraint checks a string is a I<package
-name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
-constraint checks that an I<object does> the named role.
+name> which is a role, like C<'MyApp::Role::Comparable'>.
=head2 Type Constraint Naming
use Class::MOP;
use Scalar::Util 'blessed', 'looks_like_number';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
sub Object { blessed($_[0]) && blessed($_[0]) ne 'Regexp' }
-sub Role { blessed($_[0]) && $_[0]->can('does') }
+sub Role { Carp::cluck('The Role type is deprecated.'); blessed($_[0]) && $_[0]->can('does') }
sub ClassName {
return Class::MOP::is_class_loaded( $_[0] );
use Moose::Util 'does_role', 'find_meta';
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Class::MOP;
-our $VERSION = '0.83';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 45;
+use Test::Exception;
+
+{
+ package ExGroups1;
+ use Moose::Exporter;
+ use Moose ();
+
+ Moose::Exporter->setup_import_methods(
+ also => ['Moose'],
+ with_meta => ['with_meta1'],
+ with_caller => ['default_export1'],
+ as_is => ['default_export2'],
+ groups => { all_group => [':all'],
+ just_one => ['default_export1'] }
+ );
+
+ sub default_export1 { 1 }
+ sub default_export2 { 2 }
+
+ sub with_meta1 (&) {
+ my ($meta, $code) = @_;
+ return $meta;
+ }
+}
+
+{
+ package UseAllGroup;
+
+ ExGroups1->import(':all_group');
+
+ ::can_ok( __PACKAGE__, 'with_meta1' );
+ ::can_ok( __PACKAGE__, 'default_export1' );
+ ::can_ok( __PACKAGE__, 'default_export2' );
+ ::can_ok( __PACKAGE__, 'has' );
+
+ my $meta;
+ eval q/$meta = with_meta1 { return 'coderef'; }/;
+ ::is($@, '', 'calling with_meta1 with prototype is not an error');
+ ::isa_ok( $meta, 'Moose::Meta::Class', 'with_meta first argument' );
+ ::is( prototype( __PACKAGE__->can('with_meta1') ),
+ prototype( ExGroups1->can('with_meta1') ),
+ 'using correct prototype on with_meta function' );
+
+ ExGroups1->unimport();
+
+ ::ok( ! __PACKAGE__->can('with_meta1'), __PACKAGE__.'::with_meta1() has been cleaned' );
+ ::ok( ! __PACKAGE__->can('default_export1'), __PACKAGE__.'::default_export1() has been cleaned' );
+ ::ok( ! __PACKAGE__->can('default_export2'), __PACKAGE__.'::default_export2() has been cleaned' );
+ ::ok( ! __PACKAGE__->can('has'), __PACKAGE__.'::has() has been cleaned' );
+}
+
+{
+ package UseJustOne;
+
+ ExGroups1->import(':just_one');
+
+ ::can_ok( __PACKAGE__, 'default_export1' );
+ ::ok( ! __PACKAGE__->can('default_export2'), __PACKAGE__.'::default_export2() was not imported' );
+ ::ok( ! __PACKAGE__->can('has'), __PACKAGE__.'::has() was not imported' );
+
+ ExGroups1->unimport();
+
+ ::ok( ! __PACKAGE__->can('default_export1'), __PACKAGE__.'::default_export1() has been cleared' );
+}
+
+{
+ package ExGroups2;
+ use Moose::Exporter;
+
+ Moose::Exporter->setup_import_methods(
+ also => ['ExGroups1'],
+ as_is => ['exgroups2_as_is'],
+ with_caller => ['exgroups2_with_caller'],
+ groups => { default => ['exgroups2_as_is'],
+ code_group => \&generate_group,
+ parent1 => [qw(:ExGroups1 :code_group)],
+ parent2 => [qw(:all)] }
+ );
+
+ sub exgroups2_as_is { 3 }
+
+ sub generate_group {
+ my ($caller, $group_name, $args, $context) = @_;
+
+ ::is($group_name, 'code_group', 'original name is passed to group code');
+ ::is($args->{install_as}, $caller . '_code', 'group code arguments match caller');
+ ::is($context->{from}, __PACKAGE__, 'defined package name is passed to group code');
+
+ return { $args->{install_as} => \&exported_by_group };
+ }
+
+ sub exported_by_group (&) {
+ my ($caller, $coderef) = @_;
+ return $caller;
+ }
+}
+
+{
+ package UseDefault;
+
+ ExGroups2->import;
+
+ ::can_ok( __PACKAGE__, 'exgroups2_as_is' );
+ ::ok( ! __PACKAGE__->can('exgroups2_with_caller'), '"default" group is no longer "all"' );
+}
+
+{
+ package UseCodeGroup;
+
+ ExGroups2->import(':code_group', { install_as => (my $export_name = __PACKAGE__.'_code') });
+
+ ::can_ok( __PACKAGE__, $export_name );
+ ::ok( &UseCodeGroup_code() eq __PACKAGE__, 'code group exports act like "with_caller" subs' );
+ ::lives_ok(sub { UseCodeCodeGroup_code { return 'code block'; } }, 'code group exports keep their prototypes');
+
+ ::ok( ! __PACKAGE__->can('exgroups2_as_is'), 'code group will not automatically export any symbols' );
+
+ ExGroups2->unimport;
+
+ ::ok( ! __PACKAGE__->can($export_name),
+ 'dynamically-named '. __PACKAGE__."::$export_name() has been cleared" );
+}
+
+{
+ package UseParent1;
+
+ ExGroups2->import(':parent1', { install_as => (my $export_name = __PACKAGE__.'_code') });
+
+ ::can_ok( __PACKAGE__, $export_name );
+ ::can_ok( __PACKAGE__, 'default_export1' );
+ ::can_ok( __PACKAGE__, 'default_export2' );
+ ::can_ok( __PACKAGE__, 'has' );
+
+ ExGroups2->unimport;
+
+ ::ok( ! __PACKAGE__->can($export_name), __PACKAGE__."::$export_name() has been cleared" );
+ ::ok( ! __PACKAGE__->can('default_export1'), __PACKAGE__.'::default_export1() has been cleaned' );
+ ::ok( ! __PACKAGE__->can('default_export2'), __PACKAGE__.'::default_export2() has been cleaned' );
+ ::ok( ! __PACKAGE__->can('has'), __PACKAGE__.'::has() has been cleaned' );
+}
+
+{
+ package UseParent2;
+
+ ExGroups2->import(':parent2', { install_as => (my $export_name = __PACKAGE__.'_code') });
+
+ ::ok( ! __PACKAGE__->can($export_name), '"all" group will not call code groups' );
+ ::can_ok( __PACKAGE__, 'exgroups2_as_is' );
+ ::can_ok( __PACKAGE__, 'exgroups2_with_caller' );
+ ::can_ok( __PACKAGE__, 'default_export1' );
+ ::can_ok( __PACKAGE__, 'has' );
+
+ ExGroups2->unimport;
+
+ ::ok( ! __PACKAGE__->can('exgroups2_as_is'), __PACKAGE__.'::exgroups2_as_is() has been cleaned' );
+ ::ok( ! __PACKAGE__->can('exgroups2_with_caller'), __PACKAGE__.'::exgroups2_with_caller() has been cleaned' );
+ ::ok( ! __PACKAGE__->can('default_export1'), __PACKAGE__.'::default_export1() has been cleaned' );
+ ::ok( ! __PACKAGE__->can('has'), __PACKAGE__.'::has() has been cleaned' );
+}
+
use strict;
use warnings;
-use Test::More tests => 13;
+use Test::More tests => 14;
use Test::Exception;
);
};
::ok(!$@, '... created the lazy reader method okay') or warn $@;
+
+ my $warn;
+
+ eval {
+ local $SIG{__WARN__} = sub { $warn = $_[0] };
+ has 'mtfnpy' => (
+ reder => 'get_mftnpy'
+ );
+ };
+ ::ok($warn, '... got a warning for mispelled attribute argument');
}
{
has 'bar' => (is => 'rw', does => 'Bar::Role');
has 'baz' => (
is => 'rw',
- does => subtype('Role', where { $_->does('Bar::Role') })
+ does => role_type('Bar::Role')
);
package Bar::Role;
use Moose ();
use Moose::Meta::Class;
-my $meta = Moose::Meta::Class->create_anon_class;
+my $meta = Moose::Meta::Class->create('Banana');
my $warn;
$SIG{__WARN__} = sub { $warn = "@_" };
$meta->add_attribute('foo');
-like $warn, qr/Attribute \(foo\) has no associated methods/,
+like $warn, qr/Attribute \(foo\) of class Banana has no associated methods/,
'correct error message';
$warn = '';
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+ eval "use Test::Output;";
+ plan skip_all => "Test::Output is required for this test" if $@;
+ plan tests => 5;
+}
+
+{
+ package Foo;
+ use Moose;
+
+ sub get_a { }
+ sub set_b { }
+ sub has_c { }
+ sub clear_d { }
+ sub e { }
+}
+
+my $foo_meta = Foo->meta;
+stderr_like(sub { $foo_meta->add_attribute(a => (reader => 'get_a')) },
+ qr/^You cannot overwrite a locally defined method \(get_a\) with an accessor/, 'reader overriding gives proper warning');
+stderr_like(sub { $foo_meta->add_attribute(b => (writer => 'set_b')) },
+ qr/^You cannot overwrite a locally defined method \(set_b\) with an accessor/, 'writer overriding gives proper warning');
+stderr_like(sub { $foo_meta->add_attribute(c => (predicate => 'has_c')) },
+ qr/^You cannot overwrite a locally defined method \(has_c\) with an accessor/, 'predicate overriding gives proper warning');
+stderr_like(sub { $foo_meta->add_attribute(d => (clearer => 'clear_d')) },
+ qr/^You cannot overwrite a locally defined method \(clear_d\) with an accessor/, 'clearer overriding gives proper warning');
+stderr_like(sub { $foo_meta->add_attribute(e => (is => 'rw')) },
+ qr/^You cannot overwrite a locally defined method \(e\) with an accessor/, 'accessor overriding gives proper warning');
use strict;
use warnings;
-use Test::More tests => 36;
+use Test::More tests => 41;
use Test::Exception;
=pod
ok($foo_role->has_attribute('bar'), '... FooRole does have the bar attribute');
-is_deeply(
- $foo_role->get_attribute('bar'),
- { is => 'rw', isa => 'Foo' },
- '... got the correct description of the bar attribute');
+my $bar_attr = $foo_role->get_attribute('bar');
+is($bar_attr->{is}, 'rw',
+ 'bar attribute is rw');
+is($bar_attr->{isa}, 'Foo',
+ 'bar attribute isa Foo');
+is(ref($bar_attr->{definition_context}), 'HASH',
+ 'bar\'s definition context is a hash');
+is($bar_attr->{definition_context}->{package}, 'FooRole',
+ 'bar was defined in FooRole');
ok($foo_role->has_attribute('baz'), '... FooRole does have the baz attribute');
-is_deeply(
- $foo_role->get_attribute('baz'),
- { is => 'ro' },
- '... got the correct description of the baz attribute');
+my $baz_attr = $foo_role->get_attribute('baz');
+is($baz_attr->{is}, 'ro',
+ 'baz attribute is ro');
+is(ref($baz_attr->{definition_context}), 'HASH',
+ 'bar\'s definition context is a hash');
+is($baz_attr->{definition_context}->{package}, 'FooRole',
+ 'baz was defined in FooRole');
# method modifiers
--- /dev/null
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+
+# test role and class
+package SomeRole;
+use Moose::Role;
+
+requires 'foo';
+
+package SomeClass;
+use Moose;
+has 'foo' => (is => 'rw');
+with 'SomeRole';
+
+package main;
+
+#my $c = SomeClass->new;
+#isa_ok( $c, 'SomeClass');
+
+for my $modifier_type (qw[ before around after ]) {
+ my $get_func = "get_${modifier_type}_method_modifiers";
+ my @mms = eval{ SomeRole->meta->$get_func('foo') };
+ is($@, '', "$get_func for no method mods does not die");
+ is(scalar(@mms),0,'is an empty list');
+}
use strict;
use warnings;
-use Test::More tests => 291;
+use Test::More tests => 277;
use Test::Exception;
use Scalar::Util ();
ok(defined Object(bless {}, 'Foo'), '... Object accepts anything which is blessed');
ok(!defined Object(undef), '... Object accepts anything which is blessed');
-{
- package My::Role;
- sub does { 'fake' }
-}
-
-ok(!defined Role(0), '... Role rejects anything which is not a Role');
-ok(!defined Role(100), '... Role rejects anything which is not a Role');
-ok(!defined Role(''), '... Role rejects anything which is not a Role');
-ok(!defined Role('Foo'), '... Role rejects anything which is not a Role');
-ok(!defined Role([]), '... Role rejects anything which is not a Role');
-ok(!defined Role({}), '... Role rejects anything which is not a Role');
-ok(!defined Role(sub {}), '... Role rejects anything which is not a Role');
-ok(!defined Role($SCALAR_REF), '... Role rejects anything which is not a Role');
-ok(!defined Role($GLOB_REF), '... Role rejects anything which is not a Role');
-ok(!defined Role($fh), '... Role rejects anything which is not a Role');
-ok(!defined Role(qr/../), '... Role rejects anything which is not a Role');
-ok(!defined Role(bless {}, 'Foo'), '... Role rejects anything which is not a Role');
-ok(defined Role(bless {}, 'My::Role'), '... Role accepts anything which is a Role');
-ok(!defined Role(undef), '... Role rejects anything which is not a Role');
-
ok(!defined ClassName(0), '... ClassName rejects anything which is not a ClassName');
ok(!defined ClassName(100), '... ClassName rejects anything which is not a ClassName');
ok(!defined ClassName(''), '... ClassName rejects anything which is not a ClassName');
use strict;
use warnings;
-use Test::More tests => 19;
+use Test::More tests => 18;
use Test::Exception;
BEGIN {
ok( $type->is_subtype_of("Bar"), "subtype of bar" );
ok( $type->is_subtype_of("Object"), "subtype of Object" );
-ok( $type->is_subtype_of("Role"), "subtype of Role" );
ok( !$type->is_subtype_of("ThisTypeDoesNotExist"), "not subtype of unknown type name" );
ok( !$type->is_a_type_of("ThisTypeDoesNotExist"), "not type of unknown type name" );
'Moose::Meta::TypeConstraint::Class' =>
[qw( equals is_a_type_of is_a_subtype_of )],
'Moose::Meta::TypeConstraint::Enum' => [qw( constraint equals )],
+ 'Moose::Meta::TypeConstraint::DuckType' => [qw( constraint equals get_message )],
'Moose::Meta::TypeConstraint::Parameterizable' => ['.+'],
'Moose::Meta::TypeConstraint::Parameterized' => ['.+'],
'Moose::Meta::TypeConstraint::Role' => [qw( equals is_a_type_of )],
destructors
dev
DWIM
+DUCKTYPE
hashrefs
hotspots
immutabilize
projects / gitmo/Moose.git / commitdiff