use strict;
use warnings;
-our $VERSION = '0.23';
+our $VERSION = '0.27';
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed', 'reftype';
-use Carp 'confess';
-use Sub::Name 'subname';
-use B 'svref_2object';
+use Carp 'confess';
+use Sub::Name 'subname';
+use B 'svref_2object';
use Sub::Exporter;
use Moose::Meta::Attribute;
use Moose::Meta::Instance;
+use Moose::Meta::Role;
+
use Moose::Object;
use Moose::Util::TypeConstraints;
{
my $CALLER;
- sub _init_meta {
- my $class = $CALLER;
+ sub init_meta {
+ my ( $class, $base_class, $metaclass ) = @_;
+ $base_class = $class 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) }
+ subtype $class => as 'Object' => where { $_->isa($class) } =>
+ optimize_as { blessed( $_[0] ) && $_[0]->isa($class) }
unless find_type_constraint($class);
my $meta;
- if ($class->can('meta')) {
+ if ( $class->can('meta') ) {
# NOTE:
- # this is the case where the metaclass pragma
- # was used before the 'use Moose' statement to
+ # this is the case where the metaclass pragma
+ # was used before the 'use Moose' statement to
# override a specific class
$meta = $class->meta();
- (blessed($meta) && $meta->isa('Moose::Meta::Class'))
- || confess "You already have a &meta function, but it does not return a Moose::Meta::Class";
+ ( blessed($meta) && $meta->isa('Moose::Meta::Class') )
+ || confess
+"You already have a &meta function, but it does not return a Moose::Meta::Class";
}
else {
# NOTE:
- # this is broken currently, we actually need
- # to allow the possiblity of an inherited
- # meta, which will not be visible until the
- # user 'extends' first. This needs to have
- # more intelligence to it
- $meta = Moose::Meta::Class->initialize($class);
- $meta->add_method('meta' => sub {
- # re-initialize so it inherits properly
- Moose::Meta::Class->initialize(blessed($_[0]) || $_[0]);
- })
+ # this is broken currently, we actually need
+ # to allow the possiblity of an inherited
+ # meta, which will not be visible until the
+ # user 'extends' first. This needs to have
+ # more intelligence to it
+ $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('Moose::Object')
- unless $meta->superclasses();
+ $meta->superclasses($base_class)
+ unless $meta->superclasses();
}
my %exports = (
return subname 'Moose::extends' => sub (@) {
confess "Must derive at least one class" unless @_;
Class::MOP::load_class($_) for @_;
- # this checks the metaclass to make sure
- # it is correct, sometimes it can get out
+
+ # 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(@_);
has => sub {
my $class = $CALLER;
return subname 'Moose::has' => sub ($;%) {
- my ($name, %options) = @_;
- my $attrs = (ref($name) eq 'ARRAY') ? $name : [($name)];
- $class->meta->_process_attribute($_, %options) for @$attrs;
+ my ( $name, %options ) = @_;
+ my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];
+ $class->meta->_process_attribute( $_, %options ) for @$attrs;
};
},
before => sub {
return subname 'Moose::before' => sub (@&) {
my $code = pop @_;
my $meta = $class->meta;
- $meta->add_before_method_modifier($_, $code) for @_;
+ $meta->add_before_method_modifier( $_, $code ) for @_;
};
},
after => sub {
return subname 'Moose::after' => sub (@&) {
my $code = pop @_;
my $meta = $class->meta;
- $meta->add_after_method_modifier($_, $code) for @_;
+ $meta->add_after_method_modifier( $_, $code ) for @_;
};
},
around => sub {
- my $class = $CALLER;
+ my $class = $CALLER;
return subname 'Moose::around' => sub (@&) {
my $code = pop @_;
my $meta = $class->meta;
- $meta->add_around_method_modifier($_, $code) for @_;
+ $meta->add_around_method_modifier( $_, $code ) for @_;
};
},
super => sub {
{
- our %SUPER_SLOT;
- no strict 'refs';
- $SUPER_SLOT{$CALLER} = \*{"${CALLER}::super"};
+ our %SUPER_SLOT;
+ no strict 'refs';
+ $SUPER_SLOT{$CALLER} = \*{"${CALLER}::super"};
}
- return subname 'Moose::super' => sub {};
+ return subname 'Moose::super' => sub { };
},
override => sub {
my $class = $CALLER;
return subname 'Moose::override' => sub ($&) {
- my ($name, $method) = @_;
- $class->meta->add_override_method_modifier($name => $method);
+ my ( $name, $method ) = @_;
+ $class->meta->add_override_method_modifier( $name => $method );
};
},
inner => sub {
{
- our %INNER_SLOT;
- no strict 'refs';
- $INNER_SLOT{$CALLER} = \*{"${CALLER}::inner"};
+ our %INNER_SLOT;
+ no strict 'refs';
+ $INNER_SLOT{$CALLER} = \*{"${CALLER}::inner"};
}
- return subname 'Moose::inner' => sub {};
+ return subname 'Moose::inner' => sub { };
},
augment => sub {
my $class = $CALLER;
return subname 'Moose::augment' => sub (@&) {
- my ($name, $method) = @_;
- $class->meta->add_augment_method_modifier($name => $method);
+ my ( $name, $method ) = @_;
+ $class->meta->add_augment_method_modifier( $name => $method );
};
},
-
+
# NOTE:
- # this is experimental, but I am not
- # happy with it. If you want to try
- # it, you will have to uncomment it
- # yourself.
- # There is a really good chance that
- # this will be deprecated, dont get
+ # this is experimental, but I am not
+ # happy with it. If you want to try
+ # it, you will have to uncomment it
+ # yourself.
+ # There is a really good chance that
+ # this will be deprecated, dont get
# too attached
# self => sub {
# return subname 'Moose::self' => sub {};
- # },
+ # },
# method => sub {
# my $class = $CALLER;
# return subname 'Moose::method' => sub {
# $method->(@_);
# });
# };
- # },
-
+ # },
+
confess => sub {
return \&Carp::confess;
},
},
);
- my $exporter = Sub::Exporter::build_exporter({
- exports => \%exports,
- groups => {
- default => [':all']
+ my $exporter = Sub::Exporter::build_exporter(
+ {
+ exports => \%exports,
+ groups => { default => [':all'] }
}
- });
-
- sub import {
- $CALLER = caller();
-
+ );
+
+ # 1 extra level because it's called by import so there's a layer of indirection
+ sub _get_caller{
+ my $offset = 1;
+ return
+ ref $_[1] && defined $_[1]->{into}
+ ? $_[1]->{into}
+ : ref $_[1] && defined $_[1]->{into_level}
+ ? caller($offset + $_[1]->{into_level})
+ : caller($offset);
+ }
+
+ sub import {
+ $CALLER = _get_caller(@_);
+
strict->import;
- warnings->import;
+ warnings->import;
# we should never export to main
return if $CALLER eq 'main';
-
- _init_meta();
-
+
+ init_meta( $CALLER, 'Moose::Object' );
+
goto $exporter;
}
-
+
sub unimport {
- no strict 'refs';
- my $class = caller();
+ no strict 'refs';
+ my $class = _get_caller(@_);
+
# loop through the exports ...
- foreach my $name (keys %exports) {
-
+ foreach my $name ( keys %exports ) {
+
# if we find one ...
- if (defined &{$class . '::' . $name}) {
- my $keyword = \&{$class . '::' . $name};
-
+ if ( defined &{ $class . '::' . $name } ) {
+ my $keyword = \&{ $class . '::' . $name };
+
# make sure it is from Moose
- my $pkg_name = eval { svref_2object($keyword)->GV->STASH->NAME };
+ my $pkg_name =
+ eval { svref_2object($keyword)->GV->STASH->NAME };
next if $@;
next if $pkg_name ne 'Moose';
-
+
# and if it is from Moose then undef the slot
- delete ${$class . '::'}{$name};
+ delete ${ $class . '::' }{$name};
}
}
}
-
-
+
}
## make 'em all immutable
$_->meta->make_immutable(
inline_constructor => 0,
- inline_accessors => 0,
-) for (
+ inline_accessors => 1, # these are Class::MOP accessors, so they need inlining
+ )
+ for (
'Moose::Meta::Attribute',
'Moose::Meta::Class',
'Moose::Meta::Instance',
'Moose::Meta::TypeConstraint',
'Moose::Meta::TypeConstraint::Union',
+ 'Moose::Meta::TypeConstraint::Parameterized',
'Moose::Meta::TypeCoercion',
'Moose::Meta::Method',
'Moose::Meta::Method::Accessor',
'Moose::Meta::Method::Constructor',
+ 'Moose::Meta::Method::Destructor',
'Moose::Meta::Method::Overriden',
-);
+
+ 'Moose::Meta::Role',
+ 'Moose::Meta::Role::Method',
+ 'Moose::Meta::Role::Method::Required',
+ );
1;
Yes, I believe that it is.
-I have two medium-to-large-ish web applications which use Moose heavily
-and have been in production (without issue) for several months now. At
-$work, we are re-writing our core offering in it. And several people on
-#moose have been using it (in production) for several months now as well.
+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.
+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
any questions or concerns, please feel free to email me, or even the list
type checking for this attribute. Moose will perform the checks during class
construction, and within any accessors. The C<$type_name> argument must be a
string. The string may be either a class name or a type defined using
-Moose's type definition features.
+Moose's type definition features. (Refer to L<Moose::Util::TypeConstraints>
+for information on how to define a new type, and how to retrieve type meta-data).
=item I<coerce =E<gt> (1|0)>
=item I<required =E<gt> (1|0)>
-This marks the attribute as being required. This means a value must be supplied
-during class construction, and the attribute may never be set to C<undef> with
-an accessor.
+This marks the attribute as being required. This means a I<defined> value must be
+supplied during class construction, and the attribute may never be set to
+C<undef> with an accessor.
=item I<weak_ref =E<gt> (1|0)>
and can typically be ignored). You B<cannot> have a trigger on a read-only
attribute.
-=item I<handles =E<gt> ARRAY | HASH | REGEXP | CODE>
+=item I<handles =E<gt> ARRAY | HASH | REGEXP | ROLE | 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
is so that we can determine (at compile time) the method list from the class.
Without an I<isa> this is just not possible.
+=item C<ROLE>
+
+With the role option, you specify the name of a role whose "interface" then
+becomes the list of methods to handle. The "interface" can be defined as; the
+methods of the role and any required methods of the role. It should be noted
+that this does B<not> include any method modifiers or generated attribute
+methods (which is consistent with role composition).
+
=item C<CODE>
This is the option to use when you really want to do something funky. You should
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 enfore at least I<some>
+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
Change the documentation string associated with the attribute.
+=item I<lazy>
+
+Change if the attribute lazily initializes the slot.
+
=item I<isa>
You I<are> allowed to change the type, B<if and only if> the new type is a
subtype of the old type.
+=item I<handles>
+
+You are allowed to B<add> a new C<handles> definition, but you are B<not>
+allowed to I<change> one.
+
=back
=item B<before $name|@names =E<gt> sub { ... }>
no Moose; # keywords are removed from the Person package
-=head1 MISC.
-
-=head2 What does Moose stand for??
-
-Moose doesn't stand for one thing in particular. However, if you
-want, here are a few of my favorites; feel free to contribute
-more :)
-
-=over 4
-
-=item Make Other Object Systems Envious
+=head1 EXTENDING AND EMBEDDING MOOSE
-=item Makes Object Orientation So Easy
+Moose also offers some options for extending or embedding it into your own
+framework. The basic premise is to have something that sets up your class'
+metaclass and export the moose declarators (C<has>, C<with>, C<extends>,...).
+Here is an example:
-=item Makes Object Orientation Spiffy- Er (sorry ingy)
+ package MyFramework;
+ use Moose;
+
+ sub import {
+ my $CALLER = caller();
-=item Most Other Object Systems Emasculate
+ strict->import;
+ warnings->import;
-=item Moose Often Ovulate Sorta Early
+ # we should never export to main
+ return if $CALLER eq 'main';
+ Moose::init_meta( $CALLER, 'MyFramework::Base' );
+ Moose->import({into => $CALLER});
-=item Moose Offers Often Super Extensions
+ # Do my custom framework stuff
+
+ return 1;
+ }
+
+=head2 B<import>
-=item Meta Object Orientation Syntax Extensions
+Moose's C<import> method supports the L<Sub::Exporter> form of C<{into =E<gt> $pkg}>
+and C<{into_level =E<gt> 1}>
-=back
+=head2 B<init_meta ($class, $baseclass, $metaclass)>
+Moose does some boot strapping: it creates a metaclass object for your class,
+and then injects a C<meta> accessor into your class to retrieve it. Then it
+sets your baseclass to Moose::Object or the value you pass in unless you already
+have one. This is all done via C<init_meta> which takes the name of your class
+and optionally a baseclass and a metaclass as arguments.
+
=head1 CAVEATS
=over 4
This might seem like a restriction, but I am of the opinion that keeping these
two features separate (yet interoperable) actually makes them easy to use, since
their behavior is then easier to predict. Time will tell whether I am right or
-not.
+not (UPDATE: so far so good).
=back
originally, I just ran with it.
=item Thanks to mst & chansen and the whole #moose poose for all the
-ideas/feature-requests/encouragement/bug-finding.
+early ideas/feature-requests/encouragement/bug-finding.
=item Thanks to David "Theory" Wheeler for meta-discussions and spelling fixes.
=over 4
+=item L<http://www.iinteractive.com/moose>
+
+This is the official web home of Moose, it contains links to our public SVN repo
+as well as links to a number of talks and articles on Moose and Moose related
+technologies.
+
=item L<Class::MOP> documentation
=item The #moose channel on irc.perl.org
=item The Moose mailing list - moose@perl.org
-=item L<http://forum2.org/moose/>
+=item Moose stats on ohloh.net - L<http://www.ohloh.net/projects/5788>
+
+=back
+
+=head2 Papers
+
+=over 4
=item L<http://www.cs.utah.edu/plt/publications/oopsla04-gff.pdf>
Anders (Debolaz) Nor Berle
+Nathan (kolibre) Gray
+
Christian (chansen) Hansen
+Hans Dieter (confound) Pearcey
+
Eric (ewilhelm) Wilhelm
Guillermo (groditi) Roditi
Scott (konobi) McWhirter
+Shlomi (rindolf) Fish
+
Yuval (nothingmuch) Kogman
Chris (perigrin) Prather
+Jonathan (jrockway) Rockway
+
+Piotr (dexter) Roszatycki
+
+Sam (mugwump) Vilain
+
... and many other #moose folks
=head1 COPYRIGHT AND LICENSE
projects / gitmo/Moose.git / blobdiff