use strict;
use warnings;
-our $VERSION = '0.04';
+our $VERSION = '0.05';
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;
-use Sub::Exporter;
{
my ( $CALLER, %METAS );
- sub meta() {
+ sub _find_meta {
my $class = $CALLER;
return $METAS{$class} if exists $METAS{$class};
|| confess "Whoops, not møøsey enough";
}
else {
- $meta = Moose::Meta::Class->initialize($class => (
- ':attribute_metaclass' => 'Moose::Meta::Attribute'
- ));
+ $meta = Moose::Meta::Class->initialize($class);
$meta->add_method('meta' => sub {
# re-initialize so it inherits properly
- Moose::Meta::Class->initialize($class => (
- ':attribute_metaclass' => 'Moose::Meta::Attribute'
- ));
+ Moose::Meta::Class->initialize(blessed($_[0]) || $_[0]);
})
}
my %exports = (
extends => sub {
- my $meta = meta();
- return sub {
+ my $meta = _find_meta();
+ return subname 'Moose::extends' => sub {
_load_all_classes(@_);
$meta->superclasses(@_)
};
},
with => sub {
- my $meta = meta();
- return sub {
+ my $meta = _find_meta();
+ return subname 'Moose::with' => sub {
my ($role) = @_;
_load_all_classes($role);
$role->meta->apply($meta);
};
},
has => sub {
- my $meta = meta();
- return sub {
+ my $meta = _find_meta();
+ return subname 'Moose::has' => sub {
my ($name, %options) = @_;
- $meta->add_attribute($name, %options)
+ 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 = $inherited_attr->clone_and_inherit_options(%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 $meta = meta();
- return sub {
+ my $meta = _find_meta();
+ return subname 'Moose::before' => sub {
my $code = pop @_;
$meta->add_before_method_modifier($_, $code) for @_;
};
},
after => sub {
- my $meta = meta();
- return sub {
+ my $meta = _find_meta();
+ return subname 'Moose::after' => sub {
my $code = pop @_;
$meta->add_after_method_modifier($_, $code) for @_;
};
},
around => sub {
- my $meta = meta();
- return sub {
+ my $meta = _find_meta();
+ return subname 'Moose::around' => sub {
my $code = pop @_;
$meta->add_around_method_modifier($_, $code) for @_;
};
},
super => sub {
- my $meta = meta();
- return sub {};
+ my $meta = _find_meta();
+ return subname 'Moose::super' => sub {};
},
override => sub {
- my $meta = meta();
- return sub {
+ my $meta = _find_meta();
+ return subname 'Moose::override' => sub {
my ($name, $method) = @_;
$meta->add_override_method_modifier($name => $method);
};
},
inner => sub {
- my $meta = meta();
- return sub {};
+ my $meta = _find_meta();
+ return subname 'Moose::inner' => sub {};
},
augment => sub {
- my $meta = meta();
- return sub {
+ my $meta = _find_meta();
+ return subname 'Moose::augment' => sub {
my ($name, $method) = @_;
$meta->add_augment_method_modifier($name => $method);
};
},
blessed => sub {
return \&Scalar::Util::blessed;
+ },
+ all_methods => sub {
+ subname 'Moose::all_methods' => sub () {
+ sub {
+ my ( $class, $delegate_class ) = @_;
+ $delegate_class->compute_all_applicable_methods();
+ }
+ }
}
);
-
- foreach my $name (keys %exports) {
- $exports{$name} = subname "Moose::${name}" => $exports{$name};
- }
-
+
my $exporter = Sub::Exporter::build_exporter({
exports => \%exports,
groups => {
}
});
- sub import {
+ sub import {
$CALLER = caller();
# we should never export to main
return if $CALLER eq 'main';
goto $exporter;
- };
+ }
}
## Utility functions
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<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.
+
=back
=item B<before $name|@names =E<gt> sub { ... }>
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