use strict;
use warnings;
-our $VERSION = '0.03_01';
+our $VERSION = '0.09_03';
use Scalar::Util 'blessed', 'reftype';
use Carp 'confess';
use Sub::Name 'subname';
use UNIVERSAL::require;
+use Sub::Exporter;
use Class::MOP;
use Moose::Meta::TypeConstraint;
use Moose::Meta::TypeCoercion;
use Moose::Meta::Attribute;
+use Moose::Meta::Instance;
use Moose::Object;
use Moose::Util::TypeConstraints;
-sub import {
- shift;
- my $pkg = caller();
-
- # we should never export to main
- return if $pkg eq 'main';
-
- Moose::Util::TypeConstraints->import($pkg);
-
- # make a subtype for each Moose class
- subtype $pkg
- => as 'Object'
- => where { $_->isa($pkg) };
-
- my $meta;
- if ($pkg->can('meta')) {
- $meta = $pkg->meta();
- (blessed($meta) && $meta->isa('Class::MOP::Class'))
- || confess "Whoops, not møøsey enough";
- }
- else {
- $meta = Moose::Meta::Class->initialize($pkg => (
- ':attribute_metaclass' => 'Moose::Meta::Attribute'
- ));
- $meta->add_method('meta' => sub {
- # re-initialize so it inherits properly
- Moose::Meta::Class->initialize($pkg => (
- ':attribute_metaclass' => 'Moose::Meta::Attribute'
- ));
- })
- }
-
- # NOTE:
- # &alias_method will install the method, but it
- # will not name it with
-
- # handle superclasses
- $meta->alias_method('extends' => subname 'Moose::extends' => sub {
- _load_all_classes(@_);
- $meta->superclasses(@_)
- });
-
- # handle roles
- $meta->alias_method('with' => subname 'Moose::with' => sub {
- my ($role) = @_;
- _load_all_classes($role);
- $role->meta->apply($meta);
- });
-
- # handle attributes
- $meta->alias_method('has' => subname 'Moose::has' => sub {
- my ($name, %options) = @_;
- $meta->add_attribute($name, %options)
- });
-
- # handle method modifers
- $meta->alias_method('before' => subname 'Moose::before' => sub {
- my $code = pop @_;
- $meta->add_before_method_modifier($_, $code) for @_;
- });
- $meta->alias_method('after' => subname 'Moose::after' => sub {
- my $code = pop @_;
- $meta->add_after_method_modifier($_, $code) for @_;
- });
- $meta->alias_method('around' => subname 'Moose::around' => sub {
- my $code = pop @_;
- $meta->add_around_method_modifier($_, $code) for @_;
- });
-
- $meta->alias_method('super' => subname 'Moose::super' => sub {});
- $meta->alias_method('override' => subname 'Moose::override' => sub {
- my ($name, $method) = @_;
- $meta->add_override_method_modifier($name => $method);
- });
-
- $meta->alias_method('inner' => subname 'Moose::inner' => sub {});
- $meta->alias_method('augment' => subname 'Moose::augment' => sub {
- my ($name, $method) = @_;
- $meta->add_augment_method_modifier($name => $method);
- });
-
- # make sure they inherit from Moose::Object
- $meta->superclasses('Moose::Object')
- unless $meta->superclasses();
-
- # we recommend using these things
- # so export them for them
- $meta->alias_method('confess' => \&Carp::confess);
- $meta->alias_method('blessed' => \&Scalar::Util::blessed);
+{
+ my $CALLER;
+
+ sub _init_meta {
+ my $class = $CALLER;
+
+ # make a subtype for each Moose class
+ subtype $class
+ => as 'Object'
+ => where { $_->isa($class) }
+ unless find_type_constraint($class);
+
+ my $meta;
+ if ($class->can('meta')) {
+ # NOTE:
+ # 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 "Whoops, not møøsey enough";
+ }
+ 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]);
+ })
+ }
+
+ # make sure they inherit from Moose::Object
+ $meta->superclasses('Moose::Object')
+ unless $meta->superclasses();
+ }
+
+ my %exports = (
+ extends => sub {
+ my $class = $CALLER;
+ return subname 'Moose::extends' => sub ($;@) {
+ _load_all_classes(@_);
+ my $meta = $class->meta;
+ foreach my $super (@_) {
+ # don't bother if it does not have a meta.
+ next unless $super->can('meta');
+ # if it's meta is a vanilla Moose,
+ # then we can safely ignore it.
+ next if blessed($super->meta) eq 'Moose::Meta::Class';
+ # but if we have anything else,
+ # we need to check it out ...
+ unless (# see if of our metaclass is incompatible
+ ($meta->isa(blessed($super->meta)) &&
+ # and see if our instance metaclass is incompatible
+ $meta->instance_metaclass->isa($super->meta->instance_metaclass)) &&
+ # ... and if we are just a vanilla Moose
+ $meta->isa('Moose::Meta::Class')) {
+ # re-initialize the meta ...
+ my $super_meta = $super->meta;
+ # NOTE:
+ # We might want to consider actually
+ # transfering any attributes from the
+ # original meta into this one, but in
+ # general you should not have any there
+ # at this point anyway, so it's very
+ # much an obscure edge case anyway
+ $meta = $super_meta->reinitialize($class => (
+ ':attribute_metaclass' => $super_meta->attribute_metaclass,
+ ':method_metaclass' => $super_meta->method_metaclass,
+ ':instance_metaclass' => $super_meta->instance_metaclass,
+ ));
+ }
+ }
+ $meta->superclasses(@_);
+ };
+ },
+ with => sub {
+ my $class = $CALLER;
+ return subname 'Moose::with' => sub ($;@) {
+ my (@roles) = @_;
+ _load_all_classes(@roles);
+ ($_->can('meta') && $_->meta->isa('Moose::Meta::Role'))
+ || confess "You can only consume roles, $_ is not a Moose role"
+ foreach @roles;
+ if (scalar @roles == 1) {
+ $roles[0]->meta->apply($class->meta);
+ }
+ else {
+ Moose::Meta::Role->combine(
+ map { $_->meta } @roles
+ )->apply($class->meta);
+ }
+ };
+ },
+ has => sub {
+ my $class = $CALLER;
+ return subname 'Moose::has' => sub ($;%) {
+ my ($name, %options) = @_;
+ my $meta = $class->meta;
+ if ($name =~ /^\+(.*)/) {
+ my $inherited_attr = $meta->find_attribute_by_name($1);
+ (defined $inherited_attr)
+ || confess "Could not find an attribute by the name of '$1' to inherit from";
+ my $new_attr;
+ if ($inherited_attr->isa('Moose::Meta::Attribute')) {
+ $new_attr = $inherited_attr->clone_and_inherit_options(%options);
+ }
+ else {
+ # NOTE:
+ # kind of a kludge to handle Class::MOP::Attributes
+ $new_attr = Moose::Meta::Attribute::clone_and_inherit_options(
+ $inherited_attr, %options
+ );
+ }
+ $meta->add_attribute($new_attr);
+ }
+ else {
+ if ($options{metaclass}) {
+ _load_all_classes($options{metaclass});
+ $meta->add_attribute($options{metaclass}->new($name, %options));
+ }
+ else {
+ $meta->add_attribute($name, %options);
+ }
+ }
+ };
+ },
+ before => sub {
+ my $class = $CALLER;
+ return subname 'Moose::before' => sub (@&) {
+ my $code = pop @_;
+ my $meta = $class->meta;
+ $meta->add_before_method_modifier($_, $code) for @_;
+ };
+ },
+ after => sub {
+ my $class = $CALLER;
+ return subname 'Moose::after' => sub (@&) {
+ my $code = pop @_;
+ my $meta = $class->meta;
+ $meta->add_after_method_modifier($_, $code) for @_;
+ };
+ },
+ around => sub {
+ my $class = $CALLER;
+ return subname 'Moose::around' => sub (@&) {
+ my $code = pop @_;
+ my $meta = $class->meta;
+ $meta->add_around_method_modifier($_, $code) for @_;
+ };
+ },
+ 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);
+ };
+ },
+ 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);
+ };
+ },
+ confess => sub {
+ return \&Carp::confess;
+ },
+ blessed => sub {
+ return \&Scalar::Util::blessed;
+ }
+ );
+
+ my $exporter = Sub::Exporter::build_exporter({
+ exports => \%exports,
+ groups => {
+ default => [':all']
+ }
+ });
+
+ sub import {
+ $CALLER = caller();
+
+ strict->import;
+ warnings->import;
+
+ # we should never export to main
+ return if $CALLER eq 'main';
+
+ _init_meta();
+
+ goto $exporter;
+ }
}
## Utility functions
=head1 SYNOPSIS
package Point;
+ use strict;
+ use warnings;
use Moose;
- has 'x' => (isa => 'Int', is => 'rw');
- has 'y' => (isa => 'Int', is => 'rw');
+ has 'x' => (is => 'rw', isa => 'Int');
+ has 'y' => (is => 'rw', isa => 'Int');
sub clear {
my $self = shift;
}
package Point3D;
+ use strict;
+ use warnings;
use Moose;
extends 'Point';
- has 'z' => (isa => 'Int');
+ has 'z' => (is => 'rw', isa => 'Int');
after 'clear' => sub {
my $self = shift;
- $self->{z} = 0;
+ $self->z(0);
};
=head1 CAVEAT
-This is a B<very> early release of this module, it still needs
-some fine tuning and B<lots> more documentation. I am adopting
-the I<release early and release often> approach with this module,
-so keep an eye on your favorite CPAN mirror!
+Moose is a rapidly maturing module, and is already being used by
+a number of people. It's test suite is growing larger by the day,
+and the docs should soon follow.
+
+This said, Moose is not yet finished, and should still be considered
+to be evolving. Much of the outer API is stable, but the internals
+are still subject to change (although not without serious thought
+given to it).
+
+For more details, please refer to the L<FUTURE PLANS> section of
+this document.
=head1 DESCRIPTION
Perl 5 objects better, but it also provides the power of metaclass
programming.
-=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
-
-=item Makes Object Orientation So Easy
+=head2 Can I use this in production? Or is this just an experiment?
-=item Makes Object Orientation Spiffy- Er (sorry ingy)
+Moose is I<based> on the prototypes and experiments I did for the Perl 6
+meta-model, however Moose is B<NOT> an experiment/prototype, it is
+for B<real>. I will be deploying Moose into production environments later
+this year, and I have all intentions of using it as my de-facto class
+builderfrom now on.
-=item Most Other Object Systems Emasculate
+=head2 Is Moose just Perl 6 in Perl 5?
-=item My Overcraft Overfilled (with) Some Eels
-
-=item Moose Often Ovulate Sorta Early
-
-=item Many Overloaded Object Systems Exists
-
-=item Moose Offers Often Super Extensions
-
-=back
+No. While Moose is very much inspired by Perl 6, it is not. Instead, it
+is an OO system for Perl 5. I built Moose because I was tired or writing
+the same old boring Perl 5 OO code, and drooling over Perl 6 OO. So
+instead of switching to Ruby, I wrote Moose :)
=head1 BUILDING CLASSES WITH MOOSE
Moose makes every attempt to provide as much convience during class
construction/definition, but still stay out of your way if you want
-it to. Here are some of the features Moose provides:
+it to. Here are a few items to note when building classes with Moose.
Unless specified with C<extends>, any class which uses Moose will
inherit from L<Moose::Object>.
replace it. This is important to ensure that classes which do not have
superclasses properly inherit from L<Moose::Object>.
-=item B<with ($role)>
+=item B<with (@roles)>
-This will apply a given C<$role> to the local class. Role support is
-currently very experimental, see L<Moose::Role> for more details.
+This will apply a given set of C<@roles> to the local class. Role support
+is currently under heavy development, see L<Moose::Role> for more details.
=item B<has ($name, %options)>
This will install an attribute of a given C<$name> into the current class.
-The list of C<%options> are the same as those provided by both
-L<Class::MOP::Attribute> and L<Moose::Meta::Attribute>, in addition to a
-few convience ones provided by Moose which are listed below:
+The list of C<%options> are the same as those provided by
+L<Class::MOP::Attribute>, in addition to the list below which are provided
+by Moose (L<Moose::Meta::Attribute> to be more specific):
=over 4
accessor respectively, using the same name as the C<$name> of the attribute.
If you need more control over how your accessors are named, you can use the
-I<reader>, I<writer> and I<accessor> options inherited from L<Moose::Meta::Attribute>.
+I<reader>, I<writer> and I<accessor> options inherited from L<Class::MOP::Attribute>.
=item I<isa =E<gt> $type_name>
string. The string can be either a class name, or a type defined using
Moose's type defintion features.
+=item I<coerce =E<gt> (1|0)>
+
+This will attempt to use coercion with the supplied type constraint to change
+the value passed into any accessors of constructors. You B<must> have supplied
+a type constraint in order for this to work. See L<Moose::Cookbook::Recipe5>
+for an example usage.
+
+=item I<does =E<gt> $role_name>
+
+This will accept the name of a role which the value stored in this attribute
+is expected to have consumed.
+
+=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 can never be set to C<undef> with
+an accessor.
+
+=item I<weak_ref =E<gt> (1|0)>
+
+This will tell the class to strore the value of this attribute as a weakened
+reference. If an attribute is a weakened reference, it can B<not> also be coerced.
+
+=item I<lazy =E<gt> (1|0)>
+
+This will tell the class to not create this slot until absolutely nessecary.
+If an attribute is marked as lazy it B<must> have a default supplied.
+
+=item I<auto_deref =E<gt> (1|0)>
+
+This tells the accessor whether to automatically de-reference the value returned.
+This is only legal if your C<isa> option is either an C<ArrayRef> or C<HashRef>.
+
+=item I<trigger =E<gt> $code>
+
+The trigger option is a CODE reference which will be called after the value of
+the attribute is set. The CODE ref will be passed the instance itself, the
+updated value and the attribute meta-object (this is for more advanced fiddling
+and can typically be ignored in most cases). You can B<not> have a trigger on
+a read-only attribute.
+
+=item I<handles =E<gt> [ @handles ]>
+
+There is experimental support for attribute delegation using the C<handles>
+option. More docs to come later.
+
=back
=item B<before $name|@names =E<gt> sub { ... }>
=back
+=head1 FUTURE PLANS
+
+Here is just a sampling of the plans we have in store for Moose:
+
+=over 4
+
+=item *
+
+Compiling Moose classes/roles into C<.pmc> files for faster loading and execution.
+
+=item *
+
+Supporting sealed and finalized classes in Moose. This will allow greater control
+of the extensions of frameworks and such.
+
+=back
+
+=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
+
+=item Makes Object Orientation So Easy
+
+=item Makes Object Orientation Spiffy- Er (sorry ingy)
+
+=item Most Other Object Systems Emasculate
+
+=item Moose Often Ovulate Sorta Early
+
+=item Moose Offers Often Super Extensions
+
+=item Meta Object Orientation Syntax Extensions
+
+=back
+
+=head1 CAVEATS
+
+=over 4
+
+=item *
+
+It should be noted that C<super> and C<inner> can B<not> be used in the same
+method. However, they can be combined together with the same class hierarchy,
+see F<t/014_override_augment_inner_super.t> for an example.
+
+The reason that this is so is because C<super> is only valid within a method
+with the C<override> modifier, and C<inner> will never be valid within an
+C<override> method. In fact, C<augment> will skip over any C<override> methods
+when searching for it's appropriate C<inner>.
+
+This might seem like a restriction, but I am of the opinion that keeping these
+two features seperate (but interoperable) actually makes them easy to use since
+their behavior is then easier to predict. Time will tell if I am right or not.
+
+=back
+
=head1 ACKNOWLEDGEMENTS
=over 4
Stevan Little E<lt>stevan@iinteractive.comE<gt>
+Christian Hansen E<lt>chansen@cpan.orgE<gt>
+
+Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
+
=head1 COPYRIGHT AND LICENSE
Copyright 2006 by Infinity Interactive, Inc.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
-=cut
\ No newline at end of file
+=cut
projects / gitmo/Moose.git / blobdiff