From: Chris Prather Date: Thu, 13 Sep 2007 23:39:10 +0000 (+0000) Subject: pod fixes X-Git-Tag: 0_26~21 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9bcfbab198e952e24687ccf404a96fa49162ac98;p=gitmo%2FMoose.git pod fixes r29031@alice-3: perigrin | 2007-09-13 10:39:32 -0500 get ourselves to 100% coverage r29032@alice-3: perigrin | 2007-09-13 15:36:39 -0500 document changes to import() r29033@alice-3: perigrin | 2007-09-13 18:39:18 -0500 expose init_meta and start documenting Extending and Embedding --- diff --git a/Changes b/Changes index 2fba568..38faad8 100644 --- a/Changes +++ b/Changes @@ -6,6 +6,10 @@ Revision history for Perl extension Moose * Moose - added all the meta classes to the immutable list and set it to inline the accessors + - fix import to allow Sub::Exporter like { into => } + and { into_level => } (perigrin) + - exposed and documented init_meta() to allow better + embedding and extending of Moose (perigrin) * Moose::Util::TypeConstraint - no longer uses package variable to keep track of diff --git a/lib/Moose.pm b/lib/Moose.pm index ef7662a..0bfd744 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -8,9 +8,9 @@ our $VERSION = '0.26'; 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; @@ -29,45 +29,52 @@ use Moose::Util::TypeConstraints; { my $CALLER; - - sub _init_meta { - my ($class, $base_class) = @_; + + 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($base_class) - unless $meta->superclasses(); + unless $meta->superclasses(); } my %exports = ( @@ -76,8 +83,9 @@ use Moose::Util::TypeConstraints; 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(@_); @@ -95,9 +103,9 @@ use Moose::Util::TypeConstraints; 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 { @@ -105,7 +113,7 @@ use Moose::Util::TypeConstraints; 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 { @@ -113,59 +121,59 @@ use Moose::Util::TypeConstraints; 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 { @@ -178,8 +186,8 @@ use Moose::Util::TypeConstraints; # $method->(@_); # }); # }; - # }, - + # }, + confess => sub { return \&Carp::confess; }, @@ -188,78 +196,81 @@ use Moose::Util::TypeConstraints; }, ); - 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 - = ref $_[1] && defined $_[1]->{into} ? $_[1]->{into} - : ref $_[1] && defined $_[1]->{into_level} ? caller($_[1]->{into_level}) - : caller(); + $CALLER = + ref $_[1] && defined $_[1]->{into} ? $_[1]->{into} + : ref $_[1] + && defined $_[1]->{into_level} ? caller( $_[1]->{into_level} ) + : caller(); strict->import; - warnings->import; + warnings->import; # we should never export to main return if $CALLER eq 'main'; - - _init_meta($CALLER, 'Moose::Object'); - + + init_meta( $CALLER, 'Moose::Object' ); + goto $exporter; } - + sub unimport { - no strict 'refs'; + no strict 'refs'; my $class = 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 => 1, -) for ( + inline_accessors => 1, + ) + for ( 'Moose::Meta::Attribute', 'Moose::Meta::Class', 'Moose::Meta::Instance', 'Moose::Meta::TypeConstraint', 'Moose::Meta::TypeConstraint::Union', - 'Moose::Meta::TypeConstraint::Container', + 'Moose::Meta::TypeConstraint::Container', 'Moose::Meta::TypeCoercion', 'Moose::Meta::Method', 'Moose::Meta::Method::Accessor', 'Moose::Meta::Method::Constructor', - 'Moose::Meta::Method::Destructor', + 'Moose::Meta::Method::Destructor', 'Moose::Meta::Method::Overriden', 'Moose::Meta::Role', - 'Moose::Meta::Role::Method', - 'Moose::Meta::Role::Method::Required', -); + 'Moose::Meta::Role::Method', + 'Moose::Meta::Role::Method::Required', + ); 1; @@ -705,6 +716,44 @@ to work. Here is an example: no Moose; # keywords are removed from the Person package +=head1 EXTENDING AND EMBEDDING MOOSE + +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, C, C,...). +Here is an example: + + package MyFramework; + use Moose; + + sub import { + my $CALLER = caller(); + + strict->import; + warnings->import; + + # we should never export to main + return if $CALLER eq 'main'; + Moose::init_meta( $CALLER, 'MyFramework::Base' ); + Moose->import({into => $CALLER}); + + # Do my custom framework stuff + + return 1; + } + +=head2 B + +Moose's C method supports the Sub::Exporter form of C<{into =E $pkg}> +and C<{into_level =E 1}> + +=head2 B + +Moose does some boot strapping: it creates a metaclass object for your class, +and then injects a C accessor into your class. Then it sets a baseclass +unlesss one is already defined. This is all done via C which takes +the name of your class and optionally a baseclass and a metaclass as arguments. + =head1 CAVEATS =over 4