Revision history for Perl extension Moose
+0.49
+ * Moose::Meta::Attribute
+ - fixed how the is => (ro|rw) works with
+ custom defined reader, writer and accessor
+ options.
+ - added docs for this (TODO).
+ - added tests for this (Thanks to Penfold)
+ - added the custom attribute alias for regular
+ Moose attributes which is "Moose"
+
+ * Moose
+ Moose::Meta::Class
+ Moose::Meta::Attribute
+ Moose::Meta::Role
+ Moose::Meta::Role::Composite
+ Moose::Util::TypeConstraints
+ -
+
0.48 Thurs. May 29, 2008
(early morning release engineering)--
-Moose version 0.48
+Moose version 0.49
===========================
See the individual module documentation for more information
use strict;
use warnings;
-our $VERSION = '0.48';
+our $VERSION = '0.49';
our $AUTHORITY = 'cpan:STEVAN';
-use Scalar::Util 'blessed', 'reftype';
+use Scalar::Util 'blessed';
use Carp 'confess', 'croak', 'cluck';
use Sub::Exporter;
use strict;
use warnings;
-use Scalar::Util 'blessed', 'weaken', 'reftype';
+use Scalar::Util 'blessed', 'weaken';
use Carp 'confess';
use overload ();
-our $VERSION = '0.24';
+our $VERSION = '0.26';
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Method::Accessor;
my ($class, $name, $options) = @_;
if (exists $options->{is}) {
+
+=pod
+
+is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before
+is => rw, writer => _foo # turns into (reader => foo, writer => _foo)
+is => rw, accessor => _foo # turns into (accessor => _foo)
+is => ro, accessor => _foo # error, accesor is rw
+
+=cut
+
if ($options->{is} eq 'ro') {
+ confess "Cannot define an accessor name on a read-only attribute, accessors are read/write"
+ if exists $options->{accessor};
$options->{reader} ||= $name;
}
elsif ($options->{is} eq 'rw') {
- $options->{accessor} = $name;
+ if ($options->{writer}) {
+ $options->{reader} ||= $name;
+ }
+ else {
+ $options->{accessor} ||= $name;
+ }
}
else {
confess "I do not understand this option (is => " . $options->{is} . ") on attribute $name"
}
if (exists $options->{trigger}) {
- (reftype($options->{trigger}) || '') eq 'CODE'
+ ('CODE' eq ref $options->{trigger})
|| confess "Trigger must be a CODE ref";
}
#cluck("Not delegating method '$handle' because it is a core method") and
next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle);
- if ((reftype($method_to_call) || '') eq 'CODE') {
+ if ('CODE' eq ref($method_to_call)) {
$associated_class->add_method($handle => Class::MOP::subname($name, $method_to_call));
}
else {
}
}
+package Moose::Meta::Attribute::Custom::Moose;
+sub register_implementation { 'Moose::Meta::Attribute' }
+
1;
__END__
use Class::MOP;
use Carp 'confess';
-use Scalar::Util 'weaken', 'blessed', 'reftype';
+use Scalar::Util 'weaken', 'blessed';
-our $VERSION = '0.23';
+our $VERSION = '0.24';
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Method::Overriden;
use metaclass;
use Carp 'confess';
-use Scalar::Util 'blessed', 'reftype';
+use Scalar::Util 'blessed';
-our $VERSION = '0.14';
+our $VERSION = '0.15';
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Class;
|| confess "You must define a method name";
my $body = (blessed($method) ? $method->body : $method);
- ('CODE' eq (reftype($body) || ''))
+ ('CODE' eq ref($body))
|| confess "Your code block must be a CODE reference";
$self->add_package_symbol("&${method_name}" => $body);
use metaclass;
use Carp 'confess';
-use Scalar::Util 'blessed', 'reftype';
+use Scalar::Util 'blessed';
-our $VERSION = '0.02';
+our $VERSION = '0.03';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Moose::Meta::Role';
use warnings;
use Carp 'confess';
-use Scalar::Util 'blessed', 'reftype';
+use Scalar::Util 'blessed';
use Sub::Exporter;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
our $AUTHORITY = 'cpan:STEVAN';
## --------------------------------------------------------
# subtype(MyNumbers => as Num); # now MyNumbers is the same as Num
# ... yeah I know it's ugly code
# - SL
- unshift @_ => undef if scalar @_ <= 2 && (reftype($_[1]) || '') eq 'CODE';
+ unshift @_ => undef if scalar @_ <= 2 && ('CODE' eq ref($_[1]));
goto &_create_type_constraint;
}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 18;
+use Test::Exception;
+
+BEGIN {
+ use_ok('Moose');
+}
+
+=pod
+
+ is => rw, writer => _foo # turns into (reader => foo, writer => _foo)
+ is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before
+ is => rw, accessor => _foo # turns into (accessor => _foo)
+ is => ro, accessor => _foo # error, accesor is rw
+
+=cut
+
+sub make_class {
+ my ($is, $attr, $class) = @_;
+
+ eval "package $class; use Moose; has 'foo' => ( is => '$is', $attr => '_foo' );";
+
+ return $@ ? die $@ : $class;
+}
+
+my $obj;
+my $class;
+
+$class = make_class('rw', 'writer', 'Test::Class::WriterRW');
+ok($class, "Can define attr with rw + writer");
+
+$obj = $class->new();
+
+can_ok($obj, qw/foo _foo/);
+lives_ok {$obj->_foo(1)} "$class->_foo is writer";
+is($obj->foo(), 1, "$class->foo is reader");
+dies_ok {$obj->foo(2)} "$class->foo is not writer"; # this should fail
+ok(!defined $obj->_foo(), "$class->_foo is not reader");
+
+$class = make_class('ro', 'writer', 'Test::Class::WriterRO');
+ok($class, "Can define attr with ro + writer");
+
+$obj = $class->new();
+
+can_ok($obj, qw/foo _foo/);
+lives_ok {$obj->_foo(1)} "$class->_foo is writer";
+is($obj->foo(), 1, "$class->foo is reader");
+dies_ok {$obj->foo(1)} "$class->foo is not writer";
+isnt($obj->_foo(), 1, "$class->_foo is not reader");
+
+$class = make_class('rw', 'accessor', 'Test::Class::AccessorRW');
+ok($class, "Can define attr with rw + accessor");
+
+$obj = $class->new();
+
+can_ok($obj, qw/_foo/);
+lives_ok {$obj->_foo(1)} "$class->_foo is writer";
+is($obj->_foo(), 1, "$class->foo is reader");
+
+dies_ok { make_class('ro', 'accessor', "Test::Class::AccessorRO"); } "Cant define attr with ro + accessor";
+
projects / gitmo/Moose.git / commitdiff