package MooseX::InsideOut;
# ABSTRACT: inside-out objects with Moose
-use MooseX::InsideOut::Meta::Class;
-BEGIN { require Moose }
-use Carp;
-
-sub import {
- my $class = shift;
-
- if (@_) { Carp::confess "$class has no exports" }
-
- my $into = caller;
-
- return if $into eq 'main';
-
- Moose::init_meta(
- $into,
- 'Moose::Object',
- 'MooseX::InsideOut::Meta::Class',
+use Moose ();
+use Moose::Exporter;
+use Moose::Util::MetaRole;
+use MooseX::InsideOut::Role::Meta::Instance;
+
+Moose::Exporter->setup_import_methods(
+ also => [ 'Moose' ],
+);
+
+sub init_meta {
+ shift;
+ my %p = @_;
+ Moose->init_meta(%p);
+ Moose::Util::MetaRole::apply_metaclass_roles(
+ for_class => $p{for_class},
+ instance_metaclass_roles => [ 'MooseX::InsideOut::Role::Meta::Instance' ],
);
-
- Moose->import({ into => $into });
-
- return;
}
1;
package My::Subclass;
- use metaclass 'MooseX::InsideOut::Meta::Class';
- use Moose;
+ use MooseX::InsideOut;
extends 'Some::Other::Class';
=head1 DESCRIPTION
-MooseX::InsideOut provides a metaclass and an instance metaclass for inside-out
-objects.
+MooseX::InsideOut provides metaroles for inside-out objects. That is, it sets
+up attribute slot storage somewhere other than inside C<$self>. This means
+that you can extend non-Moose classes, whose internals you either don't want to
+care about or aren't hash-based.
-You can use MooseX::InsideOut, as in the first example in the L</SYNOPSIS>.
-This sets up the metaclass and instance metaclass for you, as well as importing
-all of the normal Moose goodies.
+=method init_meta
-You can also use the metaclass C<MooseX::InsideOut::Meta::Class> directly, as
-in the second example. This is most useful when extending a non-Moose class,
-whose internals you either don't want to care about or aren't hash-based.
+Apply the instance metarole necessary for inside-out storage.
=head1 TODO
+++ /dev/null
-use strict;
-use warnings;
-
-package MooseX::InsideOut::Meta::Class;
-
-# need to load this before loading Moose and using it as a metaclass, because
-# of circularity
-use MooseX::InsideOut::Meta::Instance;
-use Moose;
-extends 'Moose::Meta::Class';
-
-sub initialize {
- my $class = shift;
- my $pkg = shift;
- $class->SUPER::initialize(
- $pkg,
- instance_metaclass => 'MooseX::InsideOut::Meta::Instance',
- @_,
- );
-}
-
-# this seems like it should be part of Moose::Meta::Class
-sub construct_instance {
- my ($class, %params) = @_;
- my $meta_instance = $class->get_meta_instance;
- my $instance = $params{'__INSTANCE__'}
- || $meta_instance->create_instance();
- foreach my $attr ($class->compute_all_applicable_attributes()) {
- my $meta_instance = $attr->associated_class->get_meta_instance;
- $attr->initialize_instance_slot($meta_instance, $instance, \%params);
- }
- return $instance;
-}
-
-1;
+++ /dev/null
-use strict;
-use warnings;
-
-package MooseX::InsideOut::Meta::Instance;
-
-use Moose;
-extends 'Moose::Meta::Instance';
-
-use Hash::Util::FieldHash::Compat qw(fieldhash);
-use Scalar::Util qw(refaddr weaken);
-
-# don't touch this or I beat you
-# this is only a package variable for inlinability
-fieldhash our %__attr;
-
-sub create_instance {
- my ($self) = @_;
-
- #my $instance = \(my $dummy);
- my $instance = $self->SUPER::create_instance;
-
- $__attr{refaddr $instance} = {};
- return bless $instance => $self->associated_metaclass->name;
-}
-
-sub get_slot_value {
- my ($self, $instance, $slot_name) = @_;
-
- return $__attr{refaddr $instance}->{$slot_name};
-}
-
-sub set_slot_value {
- my ($self, $instance, $slot_name, $value) = @_;
-
- return $__attr{refaddr $instance}->{$slot_name} = $value;
-}
-
-sub deinitialize_slot {
- my ($self, $instance, $slot_name) = @_;
-
- return delete $__attr{refaddr $instance}->{$slot_name};
-}
-
-sub is_slot_initialized {
- my ($self, $instance, $slot_name) = @_;
-
- return exists $__attr{refaddr $instance}->{$slot_name};
-}
-
-sub weaken_slot_value {
- my ($self, $instance, $slot_name) = @_;
-
- weaken $__attr{refaddr $instance}->{$slot_name};
-}
-
-sub inline_create_instance {
- my ($self, $class_variable) = @_;
- return join '',
- #'my $instance = \(my $dummy);',
- # hardcoding superclass -- can't think of a good way to avoid that
- 'my $instance = Moose::Meta::Instance->create_instance;',
- sprintf(
- '$%s::__attr{%s} = {};',
- __PACKAGE__,
- 'Scalar::Util::refaddr($instance)',
- ),
- sprintf(
- 'bless $instance => %s;',
- $class_variable,
- ),
- ;
-}
-
-sub inline_slot_access {
- my ($self, $instance, $slot_name) = @_;
- return sprintf '$%s::__attr{%s}->{%s}',
- __PACKAGE__,
- 'Scalar::Util::refaddr ' . $instance,
- $slot_name,
- ;
-}
-
-sub __dump {
- my ($class, $instance) = @_;
- require Data::Dumper;
- return Data::Dumper::Dumper($__attr{refaddr $instance});
-}
-
-1;
--- /dev/null
+package MooseX::InsideOut::Role::Meta::Instance;
+
+use Moose::Role;
+
+use Hash::Util::FieldHash::Compat qw(fieldhash);
+use Scalar::Util qw(refaddr weaken);
+use namespace::clean -except => 'meta';
+
+fieldhash our %attr;
+
+around create_instance => sub {
+ my $next = shift;
+ my $instance = shift->$next(@_);
+ $attr{refaddr $instance} = {};
+ return $instance;
+};
+
+sub get_slot_value {
+ my ($self, $instance, $slot_name) = @_;
+
+ return $attr{refaddr $instance}->{$slot_name};
+}
+
+sub set_slot_value {
+ my ($self, $instance, $slot_name, $value) = @_;
+
+ return $attr{refaddr $instance}->{$slot_name} = $value;
+}
+
+sub deinitialize_slot {
+ my ($self, $instance, $slot_name) = @_;
+ return delete $attr{refaddr $instance}->{$slot_name};
+}
+
+sub deinitialize_all_slots {
+ my ($self, $instance) = @_;
+ $attr{refaddr $instance} = {};
+}
+
+sub is_slot_initialized {
+ my ($self, $instance, $slot_name) = @_;
+
+ return exists $attr{refaddr $instance}->{$slot_name};
+}
+
+sub weaken_slot_value {
+ my ($self, $instance, $slot_name) = @_;
+ weaken $attr{refaddr $instance}->{$slot_name};
+}
+
+around inline_create_instance => sub {
+ my $next = shift;
+ my ($self, $class_variable) = @_;
+ my $code = $self->$next($class_variable);
+ $code = "do { {my \$instance = ($code);";
+ $code .= sprintf(
+ '$%s::attr{Scalar::Util::refaddr($instance)} = {};',
+ __PACKAGE__,
+ );
+ $code .= '$instance }';
+ return $code;
+};
+
+sub inline_slot_access {
+ my ($self, $instance, $slot_name) = @_;
+ return sprintf '$%s::attr{Scalar::Util::refaddr(%s)}->{%s}',
+ __PACKAGE__, $instance, $slot_name;
+}
+
+1;
+
+__END__
+
+=head1 DESCRIPTION
+
+Meta-instance role implementing inside-out storage.
+
+=method create_instance
+
+=method get_slot_value
+
+=method set_slot_value
+
+=method deinitialize_slot
+
+=method deinitialize_all_slots
+
+=method is_slot_initialized
+
+=method weaken_slot_value
+
+=method inline_create_instance
+
+=method inline_slot_access
+
+See L<Class::MOP::Instance>.
+
+=cut
package InsideOut::SubArray;
-use metaclass 'MooseX::InsideOut::Meta::Class';
-use Moose;
+use MooseX::InsideOut;
extends 'InsideOut::BaseArray';
has sub_foo => ( is => 'rw' );
package InsideOut::SubHash;
-use metaclass 'MooseX::InsideOut::Meta::Class';
-use Moose;
+use MooseX::InsideOut;
extends 'InsideOut::BaseHash';
has sub_foo => ( is => 'rw' );
package InsideOut::SubIO;
-use metaclass 'MooseX::InsideOut::Meta::Class';
-use Moose;
+use MooseX::InsideOut;
extends 'InsideOut::BaseIO';
has sub_foo => ( is => 'rw' );
package InsideOut::SubMoose;
-use metaclass 'MooseX::InsideOut::Meta::Class';
-use Moose;
+use MooseX::InsideOut;
extends 'InsideOut::BaseMoose';
has sub_foo => ( is => 'rw' );
projects / gitmo/MooseX-InsideOut.git / commitdiff