Revision history for Perl extension Moose
-0.63
+0.64
+ * Moose::Meta::Method::Accessor
+ - Always inline predicate and clearer methods (Sartak)
+
+0.63 Mon, December 8, 2008
+ * Moose::Unsweetened
+ - Some small grammar tweaks and bug fixes in non-Moose example
+ code. (Dave Rolsky)
+
+0.62_02 Fri, December 5, 2008
* Moose::Meta::Role::Application::ToClass
- When a class does not provide all of a role's required
methods, the error thrown now mentions all of the missing
inlining anyway, pass "replace_constructor => 1" to
make_immutable. Addresses RT #40968, reported by Jon
Swartz. (Dave Rolsky)
+ - The quoting of default values could be broken if the default
+ contained a single quote ('). Now we use quotemeta to escape
+ anything potentially dangerous in the defaults. (Dave Rolsky)
0.62_01 Wed, December 3, 2008
* Moose::Object
t/030_roles/024_role_composition_methods.t
t/030_roles/025_role_composition_override.t
t/030_roles/026_role_composition_method_mods.t
-t/030_roles/030_role_parameterized.t
t/030_roles/031_roles_applied_in_create.t
t/030_roles/032_roles_and_method_cloning.t
t/030_roles/033_role_exclusion_and_alias_bug.t
t/030_roles/034_create_role.t
t/030_roles/035_anonymous_roles.t
t/030_roles/036_free_anonymous_roles.t
+t/030_roles/037_create_role_subclass.t
t/040_type_constraints/001_util_type_constraints.t
t/040_type_constraints/002_util_type_constraints_export.t
t/040_type_constraints/003_util_std_type_constraints.t
t/300_immutable/003_immutable_meta_class.t
t/300_immutable/004_inlined_constructors_n_types.t
t/300_immutable/005_multiple_demolish_inline.t
-t/300_immutable/006_immutable_nonmoose_subclass.t
t/300_immutable/007_immutable_trigger_from_constructor.t
t/300_immutable/008_immutable_constructor_error.t
t/300_immutable/009_buildargs.t
+t/300_immutable/010_constructor_is_not_moose.t
+t/300_immutable/011_constructor_is_wrapped.t
+t/300_immutable/012_default_values.t
t/400_moose_util/001_moose_util.t
t/400_moose_util/002_moose_util_does_role.t
t/400_moose_util/003_moose_util_search_class_by_role.t
t/600_todo_tests/001_exception_reflects_failed_constraint.t
t/600_todo_tests/002_various_role_shit.t
t/600_todo_tests/003_immutable_n_around.t
-t/600_todo_tests/004_inlined_constructor_modified_new.t
t/600_todo_tests/005_moose_and_threads.t
t/lib/Bar.pm
t/lib/Foo.pm
requires 'perl' => '5.008';
requires 'Scalar::Util' => '1.19';
requires 'Carp';
-requires 'Class::MOP' => '0.71_01';
-requires 'List::MoreUtils';
+requires 'Class::MOP' => '0.72';
+requires 'List::MoreUtils' => '0.12';
requires 'Sub::Exporter' => '0.972';
requires 'Task::Weaken' => '0';
-Moose version 0.62_01
+Moose version 0.63
===========================
See the individual module documentation for more information
use 5.008;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Exporter;
-use Class::MOP 0.71;
+use Class::MOP 0.72;
use Moose::Meta::Class;
use Moose::Meta::TypeConstraint;
use strict;
use warnings;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Moose aims to do the same thing for Perl 5 OO. We can't actually
create new keywords, but we do offer "sugar" that looks a lot like
-them. More importantly, with Moose, you I<declaritively define> your
+them. More importantly, with Moose, you I<declaratively define> your
class, without needing to know about blessed hashrefs, accessor
methods, and so on.
apply to its own methods or methods that are inherited from its
ancestors.
-A class may I<do> one or more B<roles>.
+A class may I<do> zero or more B<roles>.
A class I<has> a B<constructor> and a B<destructor>. These are
provided for you "for free" by Moose.
Hand-written accessor methods, symbol table hackery, or a helper
module like C<Class::Accessor>.
-With Moose, these are declaritively defined, and distinct from
+With Moose, these are declaratively defined, and distinct from
methods.
=item * Method
for people who want to be Moose wizards and change how Moose works.
If you want to see how Moose would translate directly old school Perl
-5 OO code, check out the L<Moose::Unsweetened>.
+5 OO code, check out L<Moose::Unsweetened>.
=head1 AUTHOR
use Scalar::Util 'blessed', 'weaken';
use overload ();
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Method::Accessor;
use List::MoreUtils qw( any all uniq );
use Scalar::Util 'weaken', 'blessed';
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
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 { '' }
=item B<generate_writer_method>
+=item B<generate_predicate_method>
+
+=item B<generate_clearer_method>
+
=item B<generate_accessor_method_inline>
=item B<generate_reader_method_inline>
use strict;
use warnings;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Moose::Meta::Method',
return '$attrs->[' . $index . ']->default($instance)';
}
else {
- my $default = $attr->default;
- # make sure to quote strings ...
- return "'$default'";
-
+ return q{"} . quotemeta( $attr->default ) . q{"};
}
}
=item B<new>
+=item B<can_be_inlined>
+
=item B<attributes>
=item B<meta_instance>
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
use Carp 'confess';
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
my $role_name = $self->name;
my $method_metaclass = $self->method_metaclass;
- my %all_code = $self->get_all_package_symbols('CODE');
+ my $all_code = $self->get_all_package_symbols('CODE');
- foreach my $symbol (keys %all_code) {
- my $code = $all_code{$symbol};
+ foreach my $symbol (keys %{ $all_code }) {
+ my $code = $all_code->{$symbol};
next if exists $map->{$symbol} &&
defined $map->{$symbol} &&
use warnings;
use metaclass;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Role::Composite;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Util 'english_list';
use Scalar::Util 'blessed';
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Attribute;
use Moose::Util::TypeConstraints ();
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use base qw(Class::MOP::Object);
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
sub coerce { ((shift)->coercion || Moose->throw_error("Cannot coerce without a type coercion"))->coerce(@_) }
-sub check { $_[0]->_compiled_type_constraint->($_[1]) ? 1 : undef }
+
+sub check {
+ my ($self, @args) = @_;
+ my $constraint_subref = $self->_compiled_type_constraint;
+ return $constraint_subref->(@args) ? 1 : undef;
+}
+
sub validate {
my ($self, $value) = @_;
if ($self->_compiled_type_constraint->($value)) {
} else {
return Class::MOP::subname($self->name, sub {
return undef unless $optimized_parent->($_[0]);
- local $_ = $_[0];
- $check->($_[0]);
+ my (@args) = @_;
+ local $_ = $args[0];
+ $check->(@args);
});
}
} else {
my @checks = @parents;
push @checks, $check if $check != $null_constraint;
return Class::MOP::subname($self->name => sub {
- local $_ = $_[0];
+ my (@args) = @_;
+ local $_ = $args[0];
foreach my $check (@checks) {
- return undef unless $check->($_[0]);
+ return undef unless $check->(@args);
}
return 1;
});
return $check if $check == $null_constraint; # Item, Any
return Class::MOP::subname($self->name => sub {
- local $_ = $_[0];
- $check->($_[0]);
+ my (@args) = @_;
+ local $_ = $args[0];
+ $check->(@args);
});
}
use Scalar::Util 'blessed';
use Moose::Util::TypeConstraints ();
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Util::TypeConstraints ();
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use warnings;
use metaclass;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Util::TypeConstraints;
use Moose::Meta::TypeConstraint::Parameterizable;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
use Carp 'confess'; # FIXME Moose->throw_error
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
use Moose::Util::TypeConstraints ();
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::TypeCoercion::Union;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$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.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Data::OptList;
use Sub::Exporter;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
exists $p{birth_date}
or confess 'birth_date is a required attribute';
- $p{birth_date} = $class->_coerce_birth_date($date );
- $class->_validate_birth_date( $date );
+ $p{birth_date} = $class->_coerce_birth_date( $p{birth_date} );
+ $class->_validate_birth_date( $p{birth_date} );
$p{shirt_size} = 'l'
unless exists $p{shirt_size}:
$class->_validate_shirt_size( $p{shirt_size} );
- my %self = map { $_ => $p{$_} } qw( name shirt_size );
- $self{birth_date} = $date;
-
- return bless \%self, $class;
+ return bless \%p, $class;
}
sub _validate_name {
Wow, that was a mouthful! One thing to note is just how much space the
data validation code consumes. As a result, it's pretty common for
-Perl 5 programmers to just not bother, which results in much more
-fragile code.
+Perl 5 programmers to just not bother. Unfortunately, not validating
+arguments leads to surprises down the line ("why is birth_date an
+email address?").
-Did you spot the (intentional) bug?
+Also, did you spot the (intentional) bug?
It's in the C<_validate_birth_date()> method. We should check that
that value in C<$birth_date> is actually defined and object before we
go and call C<isa()> on it! Leaving out those checks means our data
validation code could actually cause our program to die. Oops.
-Also note that if we add a superclass to Person we'll have to change
-the constructor to account for that.
+Note that if we add a superclass to Person we'll have to change the
+constructor to account for that.
(As an aside, getting all the little details of what Moose does for
-you just right in this code was not easy, which just emphasizes the
-point, that Moose saves you a lot of work!)
+you just right in this example was really not easy, which emphasizes
+the point of the example. Moose saves you a lot of work!)
Now let's see User:
use Scalar::Util 'blessed';
use Class::MOP 0.60;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
use Moose::Exporter;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed', 'looks_like_number';
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Util 'does_role', 'find_meta';
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Class::MOP;
-our $VERSION = '0.62_01';
+our $VERSION = '0.63';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More skip_all => 'The feature this test exercises is not yet written';
-use Test::Exception;
-
-
-{
- package Scalar;
- use Moose::Role;
-
- BEGIN { parameter T => { isa => 'Moose::Meta::TypeConstraint' } };
-
- has 'val' => (is => 'ro', isa => T);
-
- requires 'eq';
-
- sub not_eq { ! (shift)->eq(shift) }
-}
-
-is_deeply(
- Scalar->meta->parameters,
- { T => { isa => 'Moose::Meta::TypeConstraint' } },
- '... got the right parameters in the role'
-);
-
-{
- package Integers;
- use Moose;
- use Moose::Util::TypeConstraints;
-
- with Scalar => { T => find_type_constraint('Int') };
-
- sub eq { shift == shift }
-}
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 2;
+use Moose ();
+
+do {
+ package My::Meta::Role;
+ use Moose;
+ extends 'Moose::Meta::Role';
+
+ has test_serial => (
+ is => 'ro',
+ isa => 'Int',
+ default => 1,
+ );
+
+ no Moose;
+};
+
+my $role = My::Meta::Role->create_anon_role;
+is($role->test_serial, 1, "default value for the serial attribute");
+
+my $nine_role = My::Meta::Role->create_anon_role(test_serial => 9);
+is($nine_role->test_serial, 9, "parameter value for the serial attribute");
+
#!/usr/bin/perl
+# this functionality may be pushing toward parametric roles/classes
+# it's off in a corner and may not be that important
+
use strict;
use warnings;
-use Test::More tests => 3;
+use Test::More tests => 15;
use Test::Exception;
{
my $anon;
lives_ok {
$anon = My::Metaclass->create_anon_class( foo => 'this' );
-} 'create anon class';
+} 'create anon class with required attr';
isa_ok( $anon, 'My::Metaclass' );
cmp_ok( $anon->foo, 'eq', 'this', 'foo is this' );
+dies_ok {
+ $anon = My::Metaclass->create_anon_class();
+} 'failed to create anon class without required attr';
+
+my $meta;
+lives_ok {
+ $meta
+ = My::Metaclass->initialize( 'Class::Name1' => ( foo => 'that' ) );
+} 'initialize a class with required attr';
+isa_ok( $meta, 'My::Metaclass' );
+cmp_ok( $meta->foo, 'eq', 'that', 'foo is that' );
+cmp_ok( $meta->name, 'eq', 'Class::Name1', 'for the correct class' );
+dies_ok {
+ $meta
+ = My::Metaclass->initialize( 'Class::Name2' );
+} 'failed to initialize a class without required attr';
+
+lives_ok {
+ eval qq{
+ package Class::Name3;
+ use metaclass 'My::Metaclass' => (
+ foo => 'another',
+ );
+ use Moose;
+ };
+ die $@ if $@;
+} 'use metaclass with required attr';
+$meta = Class::Name3->meta;
+isa_ok( $meta, 'My::Metaclass' );
+cmp_ok( $meta->foo, 'eq', 'another', 'foo is another' );
+cmp_ok( $meta->name, 'eq', 'Class::Name3', 'for the correct class' );
+dies_ok {
+ eval qq{
+ package Class::Name4;
+ use metaclass 'My::Metaclass';
+ use Moose;
+ };
+ die $@ if $@;
+} 'failed to use metaclass without required attr';
+
+
+# how do we pass a required attribute to -traits?
+dies_ok {
+ eval qq{
+ package Class::Name5;
+ use Moose -traits => 'HasFoo';
+ };
+ die $@ if $@;
+} 'failed to use trait without required attr';
my $mutable_string = $is_immutable ? 'immutable' : 'mutable';
lives_ok {
my $f = Foo->new(foo => 10, bar => "Hello World", baz => 10, zot => 4);
- is($f->moo, 69, "Type coersion works as expected on default ($mutable_string)");
- is($f->boo, 69, "Type coersion works as expected on builder ($mutable_string)");
+ is($f->moo, 69, "Type coercion works as expected on default ($mutable_string)");
+ is($f->boo, 69, "Type coercion works as expected on builder ($mutable_string)");
} "... this passes the constuctor correctly ($mutable_string)";
lives_ok {
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+use Test::Exception;
+
+{
+
+ package Foo;
+ use Moose;
+
+ has 'foo' => ( is => 'rw', default => q{'} );
+ has 'bar' => ( is => 'rw', default => q{\\} );
+ has 'baz' => ( is => 'rw', default => q{"} );
+ has 'buz' => ( is => 'rw', default => q{"'\\} );
+ has 'faz' => ( is => 'rw', default => qq{\0} );
+
+ ::lives_ok { __PACKAGE__->meta->make_immutable }
+ 'no errors making a package immutable when it has default values that could break quoting';
+}
+
+my $foo = Foo->new;
+is( $foo->foo, q{'},
+ 'default value for foo attr' );
+is( $foo->bar, q{\\},
+ 'default value for bar attr' );
+is( $foo->baz, q{"},
+ 'default value for baz attr' );
+is( $foo->buz, q{"'\\},
+ 'default value for buz attr' );
+is( $foo->faz, qq{\0},
+ 'default value for faz attr' );
+
+
+# Lazy attrs were never broken, but it doesn't hurt to test that they
+# won't be broken by any future changes.
+{
+
+ package Bar;
+ use Moose;
+
+ has 'foo' => ( is => 'rw', default => q{'}, lazy => 1 );
+ has 'bar' => ( is => 'rw', default => q{\\}, lazy => 1 );
+ has 'baz' => ( is => 'rw', default => q{"}, lazy => 1 );
+ has 'buz' => ( is => 'rw', default => q{"'\\}, lazy => 1 );
+ has 'faz' => ( is => 'rw', default => qq{\0}, lazy => 1 );
+
+ ::lives_ok { __PACKAGE__->meta->make_immutable }
+ 'no errors making a package immutable when it has lazy default values that could break quoting';
+}
+
+my $bar = Bar->new;
+is( $bar->foo, q{'},
+ 'default value for foo attr' );
+is( $bar->bar, q{\\},
+ 'default value for bar attr' );
+is( $bar->baz, q{"},
+ 'default value for baz attr' );
+is( $bar->buz, q{"'\\},
+ 'default value for buz attr' );
+is( $bar->faz, qq{\0},
+ 'default value for faz attr' );