use strict;
use warnings;
-our $VERSION = '0.32';
+our $VERSION = '0.40';
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed', 'reftype';
use Carp 'confess';
use Sub::Name 'subname';
-use B 'svref_2object';
use Sub::Exporter;
-use Class::MOP 0.46;
+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;
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');
+ "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') ) {
$meta = $metaclass->initialize($class);
$meta->add_method(
'meta' => sub {
-
# re-initialize so it inherits properly
$metaclass->initialize( blessed( $_[0] ) || $_[0] );
}
# make sure they inherit from Moose::Object
$meta->superclasses($base_class)
unless $meta->superclasses();
+
+ return $meta;
}
my %exports = (
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 (@roles) = @_;
- confess "Must specify at least one role" unless @roles;
- Class::MOP::load_class($_) for @roles;
- $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 {
$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;
},
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;
my $keyword = \&{ $class . '::' . $name };
# make sure it is from Moose
- my $pkg_name =
- eval { svref_2object($keyword)->GV->STASH->NAME };
+ my ($pkg_name) = Class::MOP::get_code_info($keyword);
next if $@;
next if $pkg_name ne 'Moose';
=head1 NAME
-Moose - A complete modern object system for Perl 5
+Moose - A postmodern object system for Perl 5
=head1 SYNOPSIS
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
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<post> modern, I thought it was just I<modern>?
+
+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<postmodern> object system.
+
+Nuff Said.
+
=head2 Moose Extensions
The L<MooseX::> namespace is the official place to find Moose extensions.
The default behavior here is to just load C<$metaclass_name>; however, we also
have a way to alias to a shorter name. This will first look to see if
B<Moose::Meta::Attribute::Custom::$metaclass_name> exists. If it does, Moose
-will then check to see if that has the method C<register_implemenetation>, which
+will then check to see if that has the method C<register_implementation>, which
should return the actual name of the custom attribute metaclass. If there is no
-C<register_implemenetation> method, it will fall back to using
+C<register_implementation> method, it will fall back to using
B<Moose::Meta::Attribute::Custom::$metaclass_name> as the metaclass name.
=item I<trigger =E<gt> $code>
has 'parent' => (
is => 'rw',
isa => 'Tree',
- is_weak_ref => 1,
+ weak_ref => 1,
handles => {
parent_node => 'node',
siblings => 'children',
=item B<has +$name =E<gt> %options>
This is variation on the normal attibute creator C<has> 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;
from its parent class B<Foo>, retaining the C<is =E<gt> 'rw'> and C<isa =E<gt>
'Str'> characteristics, but changing the value in C<default>.
-This feature is restricted somewhat, so as to try and force at least I<some>
-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<some> sanity into it. You are only
+allowed to change the following attributes:
=over 4
You are allowed to B<add> a new C<handles> definition, but you are B<not>
allowed to I<change> one.
+=item I<builder>
+
+You are allowed to B<add> a new C<builder> definition, but you are B<not>
+allowed to I<change> one.
+
=back
=item B<before $name|@names =E<gt> sub { ... }>
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
projects / gitmo/Moose.git / blobdiff