summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2009-09-10 18:33:50 -0500
committerJesse Luehrs <doy@tozt.net>2009-09-10 18:33:50 -0500
commit4b09119338204ab6f618b5be60cc7464d115fd39 (patch)
treed62b03cfad09a663452a309b262f86a961dc655e
parent4c5a069ebf7dd2bd3d5deec55158d56a0b7acf7b (diff)
downloadmoosex-methodtraits-4b09119338204ab6f618b5be60cc7464d115fd39.tar.gz
moosex-methodtraits-4b09119338204ab6f618b5be60cc7464d115fd39.zip
initial basic implementation
-rw-r--r--lib/MooseX/MethodTraits.pm78
1 files changed, 75 insertions, 3 deletions
diff --git a/lib/MooseX/MethodTraits.pm b/lib/MooseX/MethodTraits.pm
index 1ea6c23..14a7280 100644
--- a/lib/MooseX/MethodTraits.pm
+++ b/lib/MooseX/MethodTraits.pm
@@ -1,5 +1,5 @@
package MooseX::MethodTraits;
-use Moose;
+use Moose::Exporter;
=head1 NAME
@@ -13,8 +13,80 @@ MooseX::MethodTraits -
=cut
-__PACKAGE__->meta->make_immutable;
-no Moose;
+sub _generate_method_creators {
+ my ($package, $with_traits) = @_;
+
+ my $package_meta = Class::MOP::Package->initialize($package);
+ for my $sub (keys %$with_traits) {
+ my $spec = $with_traits->{$sub};
+ my $traits = $spec->{traits} || [];
+ my $munge = $spec->{munge} || sub { shift, \@_ };
+
+ my $code = sub {
+ my $meta = shift;
+ my $name = shift;
+ # XXX: need to do something with $args - these should be for
+ # initializing attributes in the method traits that are applied
+ my ($method, $args) = $munge->(@_);
+
+ my $method_metaclass = Moose::Meta::Class->create_anon_class(
+ superclasses => [$meta->method_metaclass],
+ roles => $traits,
+ cache => 1,
+ );
+
+ $meta->add_method(
+ $name => $method_metaclass->name->wrap(
+ $method,
+ name => $name,
+ package_name => $meta->name,
+ )
+ );
+ };
+ $package_meta->add_package_symbol('&' . $sub => $code);
+ }
+ return keys %$with_traits;
+}
+
+# XXX: factor some of this stuff out
+sub build_import_methods {
+ my $class = shift;
+ my %options = @_;
+ $options{exporting_package} ||= caller;
+ if (exists $options{with_traits}) {
+ my $with_traits = delete $options{with_traits};
+ my @extra_with_meta = _generate_method_creators(
+ $options{exporting_package}, $with_traits
+ );
+ $options{with_meta} = [
+ @{ $options{with_meta} || [] },
+ @extra_with_meta,
+ ];
+ }
+ return Moose::Exporter->build_import_methods(%options)
+}
+
+sub setup_import_methods {
+ my $class = shift;
+ my %options = @_;
+ $options{exporting_package} ||= caller;
+ if (exists $options{with_traits}) {
+ my $with_traits = delete $options{with_traits};
+ my @extra_with_meta = _generate_method_creators(
+ $options{exporting_package}, $with_traits
+ );
+ $options{with_meta} = [
+ @{ $options{with_meta} || [] },
+ @extra_with_meta,
+ ];
+ }
+ return Moose::Exporter->setup_import_methods(%options)
+}
+
+sub import {
+ strict->import;
+ warnings->import;
+}
=head1 BUGS