From: hdp <hdp@3efe9002-19ed-0310-8735-a98156148065>
Date: Sat, 4 Apr 2009 05:43:39 +0000 (+0000)
Subject: update for latest Moose
X-Git-Tag: 0.100~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=71d2a8c6639f8daa394e83f50345369967d2b490;p=gitmo%2FMooseX-InsideOut.git

update for latest Moose
---

diff --git a/lib/MooseX/InsideOut.pm b/lib/MooseX/InsideOut.pm
index 939dcc5..ba377c7 100644
--- a/lib/MooseX/InsideOut.pm
+++ b/lib/MooseX/InsideOut.pm
@@ -4,28 +4,23 @@ use warnings;
 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;
@@ -42,22 +37,19 @@ __END__
 
   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
 
diff --git a/lib/MooseX/InsideOut/Meta/Class.pm b/lib/MooseX/InsideOut/Meta/Class.pm
deleted file mode 100644
index e5984d3..0000000
--- a/lib/MooseX/InsideOut/Meta/Class.pm
+++ /dev/null
@@ -1,35 +0,0 @@
-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;
diff --git a/lib/MooseX/InsideOut/Meta/Instance.pm b/lib/MooseX/InsideOut/Meta/Instance.pm
deleted file mode 100644
index e722809..0000000
--- a/lib/MooseX/InsideOut/Meta/Instance.pm
+++ /dev/null
@@ -1,89 +0,0 @@
-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;
diff --git a/lib/MooseX/InsideOut/Role/Meta/Instance.pm b/lib/MooseX/InsideOut/Role/Meta/Instance.pm
new file mode 100644
index 0000000..77f116b
--- /dev/null
+++ b/lib/MooseX/InsideOut/Role/Meta/Instance.pm
@@ -0,0 +1,98 @@
+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
diff --git a/t/lib/InsideOut/SubArray.pm b/t/lib/InsideOut/SubArray.pm
index b2a68e8..82e9e90 100644
--- a/t/lib/InsideOut/SubArray.pm
+++ b/t/lib/InsideOut/SubArray.pm
@@ -3,8 +3,7 @@ use warnings;
 
 package InsideOut::SubArray;
 
-use metaclass 'MooseX::InsideOut::Meta::Class';
-use Moose;
+use MooseX::InsideOut;
 extends 'InsideOut::BaseArray';
 
 has sub_foo => ( is => 'rw' );
diff --git a/t/lib/InsideOut/SubHash.pm b/t/lib/InsideOut/SubHash.pm
index 8ceb3ad..2d139b0 100644
--- a/t/lib/InsideOut/SubHash.pm
+++ b/t/lib/InsideOut/SubHash.pm
@@ -3,8 +3,7 @@ use warnings;
 
 package InsideOut::SubHash;
 
-use metaclass 'MooseX::InsideOut::Meta::Class';
-use Moose;
+use MooseX::InsideOut;
 extends 'InsideOut::BaseHash';
 
 has sub_foo => ( is => 'rw' );
diff --git a/t/lib/InsideOut/SubIO.pm b/t/lib/InsideOut/SubIO.pm
index 0d74e80..99742f6 100644
--- a/t/lib/InsideOut/SubIO.pm
+++ b/t/lib/InsideOut/SubIO.pm
@@ -3,8 +3,7 @@ use warnings;
 
 package InsideOut::SubIO;
 
-use metaclass 'MooseX::InsideOut::Meta::Class';
-use Moose;
+use MooseX::InsideOut;
 extends 'InsideOut::BaseIO';
 
 has sub_foo => ( is => 'rw' );
diff --git a/t/lib/InsideOut/SubMoose.pm b/t/lib/InsideOut/SubMoose.pm
index 34e959a..8982aee 100644
--- a/t/lib/InsideOut/SubMoose.pm
+++ b/t/lib/InsideOut/SubMoose.pm
@@ -3,8 +3,7 @@ use warnings;
 
 package InsideOut::SubMoose;
 
-use metaclass 'MooseX::InsideOut::Meta::Class';
-use Moose;
+use MooseX::InsideOut;
 extends 'InsideOut::BaseMoose';
 
 has sub_foo => ( is => 'rw' );