X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose.pm;h=3c61cfd45e411f6567269c749c0e046ee5814301;hb=f02c03d6b01452536d3e3b189438d73cf16568a2;hp=85dc987323bbc8f8e4484bf804127d4845d79ad5;hpb=a4e516f663c16c559013862e7f51b0aec4fc3e5b;p=gitmo%2FMoose.git diff --git a/lib/Moose.pm b/lib/Moose.pm index 85dc987..3c61cfd 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -4,7 +4,7 @@ package Moose; use strict; use warnings; -our $VERSION = '0.34'; +our $VERSION = '0.40'; our $AUTHORITY = 'cpan:STEVAN'; use Scalar::Util 'blessed', 'reftype'; @@ -13,10 +13,11 @@ use Sub::Name 'subname'; use Sub::Exporter; -use Class::MOP 0.49; +use Class::MOP 0.51; use Moose::Meta::Class; use Moose::Meta::TypeConstraint; +use Moose::Meta::TypeConstraint::Class; use Moose::Meta::TypeCoercion; use Moose::Meta::Attribute; use Moose::Meta::Instance; @@ -25,23 +26,23 @@ use Moose::Meta::Role; use Moose::Object; use Moose::Util::TypeConstraints; +use Moose::Util (); { my $CALLER; sub init_meta { my ( $class, $base_class, $metaclass ) = @_; - $base_class = $class unless defined $base_class; - $metaclass = 'Moose::Meta::Class' unless defined $metaclass; + $base_class = 'Moose::Object' unless defined $base_class; + $metaclass = 'Moose::Meta::Class' unless defined $metaclass; confess "The Metaclass $metaclass must be a subclass of Moose::Meta::Class." unless $metaclass->isa('Moose::Meta::Class'); # make a subtype for each Moose class - subtype $class => as 'Object' => where { $_->isa($class) } => - optimize_as { blessed( $_[0] ) && $_[0]->isa($class) } - unless find_type_constraint($class); + class_type($class) + unless find_type_constraint($class); my $meta; if ( $class->can('meta') ) { @@ -63,7 +64,6 @@ use Moose::Util::TypeConstraints; $meta = $metaclass->initialize($class); $meta->add_method( 'meta' => sub { - # re-initialize so it inherits properly $metaclass->initialize( blessed( $_[0] ) || $_[0] ); } @@ -73,6 +73,8 @@ use Moose::Util::TypeConstraints; # make sure they inherit from Moose::Object $meta->superclasses($base_class) unless $meta->superclasses(); + + return $meta; } my %exports = ( @@ -80,53 +82,33 @@ use Moose::Util::TypeConstraints; my $class = $CALLER; return subname 'Moose::extends' => sub (@) { confess "Must derive at least one class" unless @_; - Class::MOP::load_class($_) for @_; + + my @supers = @_; + foreach my $super (@supers) { + Class::MOP::load_class($super); + } # this checks the metaclass to make sure # it is correct, sometimes it can get out # of sync when the classes are being built - my $meta = $class->meta->_fix_metaclass_incompatability(@_); - $meta->superclasses(@_); + my $meta = $class->meta->_fix_metaclass_incompatability(@supers); + $meta->superclasses(@supers); }; }, with => sub { my $class = $CALLER; return subname 'Moose::with' => sub (@) { - my (@args) = @_; - confess "Must specify at least one role" unless @args; - - my $roles = Data::OptList::mkopt(\@args); - - #use Data::Dumper; - #warn Dumper $roles; - - Class::MOP::load_class($_->[0]) for @$roles; - - ($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role')) - || confess "You can only consume roles, " . $_->[0] . " is not a Moose role" - foreach @$roles; - - my $meta = $class->meta; - - if (scalar @$roles == 1) { - my ($role, $params) = @{$roles->[0]}; - $role->meta->apply($meta, (defined $params ? %$params : ())); - } - else { - Moose::Meta::Role->combine( - @$roles - )->apply($meta); - } - - #$class->meta->_apply_all_roles(@roles); + Moose::Util::apply_all_roles($class->meta, @_) }; }, has => sub { my $class = $CALLER; return subname 'Moose::has' => sub ($;%) { - my ( $name, %options ) = @_; + my $name = shift; + die 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1; + my %options = @_; my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ]; - $class->meta->_process_attribute( $_, %options ) for @$attrs; + $class->meta->add_attribute( $_, %options ) for @$attrs; }; }, before => sub { @@ -183,6 +165,19 @@ use Moose::Util::TypeConstraints; $class->meta->add_augment_method_modifier( $name => $method ); }; }, + metaclass => sub { + my $class = $CALLER; + return subname 'Moose::metaclass' => sub { + $class->meta; + }; + }, + make_immutable => sub { + my $class = $CALLER; + return subname 'Moose::make_immutable' => sub { + warn "Use of make_immutable() is deprecated, please use metaclass->make_immutable now\n"; + $class->meta->make_immutable(@_); + }; + }, confess => sub { return \&Carp::confess; }, @@ -212,6 +207,11 @@ use Moose::Util::TypeConstraints; sub import { $CALLER = _get_caller(@_); + # this works because both pragmas set $^H (see perldoc perlvar) + # which affects the current compilation - i.e. the file who use'd + # us - which is why we don't need to do anything special to make + # it affect that file rather than this one (which is already compiled) + strict->import; warnings->import; @@ -282,7 +282,7 @@ __END__ =head1 NAME -Moose - A complete modern object system for Perl 5 +Moose - A postmodern object system for Perl 5 =head1 SYNOPSIS @@ -338,7 +338,7 @@ Yes, I believe that it is. Moose has been used successfully in production environemnts by several people and companies (including the one I work for). There are Moose applications -which have been in production with little or no issue now for over a year. +which have been in production with little or no issue now for well over a year. I consider it highly stable and we are commited to keeping it stable. Of course, in the end, you need to make this call yourself. If you have @@ -352,6 +352,19 @@ Instead, it is an OO system for Perl 5. I built Moose because I was tired of writing the same old boring Perl 5 OO code, and drooling over Perl 6 OO. So instead of switching to Ruby, I wrote Moose :) +=head2 Wait, I modern, I thought it was just I? + +So I was reading Larry Wall's talk from the 1999 Linux World entitled +"Perl, the first postmodern computer language" in which he talks about how +he picked the features for Perl because he thought they were cool and he +threw out the ones that he thought sucked. This got me thinking about how +we have done the same thing in Moose. For Moose, we have "borrowed" features +from Perl 6, CLOS (LISP), Smalltalk, Java, BETA, OCaml, Ruby and more, and +the bits we didn't like (cause they sucked) we tossed aside. So for this +reason (and a few others) I have re-dubbed Moose a I object system. + +Nuff Said. + =head2 Moose Extensions The L namespace is the official place to find Moose extensions. @@ -599,7 +612,8 @@ a HASH ref) of the methods you want mapped. =item B %options> This is variation on the normal attibute creator C which allows you to -clone and extend an attribute from a superclass. Here is a quick example: +clone and extend an attribute from a superclass or from a role. Here is an +example of the superclass usage: package Foo; use Moose; @@ -621,8 +635,31 @@ What is happening here is that B is cloning the C attribute from its parent class B, retaining the C 'rw'> and C 'Str'> characteristics, but changing the value in C. -This feature is restricted somewhat, so as to try and force at least I -sanity into it. You are only allowed to change the following attributes: +Here is another example, but within the context of a role: + + package Foo::Role; + use Moose::Role; + + has 'message' => ( + is => 'rw', + isa => 'Str', + default => 'Hello, I am a Foo' + ); + + package My::Foo; + use Moose; + + with 'Foo::Role'; + + has '+message' => (default => 'Hello I am My::Foo'); + +In this case, we are basically taking the attribute which the role supplied +and altering it within the bounds of this feature. + +Aside from where the attributes come from (one from superclass, the other +from a role), this feature works exactly the same. This feature is restricted +somewhat, so as to try and force at least I sanity into it. You are only +allowed to change the following attributes: =over 4 @@ -656,6 +693,11 @@ subtype of the old type. You are allowed to B a new C definition, but you are B allowed to I one. +=item I + +You are allowed to B a new C definition, but you are B +allowed to I one. + =back =item B sub { ... }>