import 0.001
hdp [Tue, 29 Jan 2008 13:11:01 +0000 (13:11 +0000)]
19 files changed:
Changes [new file with mode: 0644]
MANIFEST [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
README [new file with mode: 0644]
lib/MooseX/InsideOut.pm [new file with mode: 0644]
lib/MooseX/InsideOut/Meta/Class.pm [new file with mode: 0644]
lib/MooseX/InsideOut/Meta/Instance.pm [new file with mode: 0644]
t/00-load.t [new file with mode: 0644]
t/lib/InsideOut/BaseArray.pm [new file with mode: 0644]
t/lib/InsideOut/BaseHash.pm [new file with mode: 0644]
t/lib/InsideOut/BaseIO.pm [new file with mode: 0644]
t/lib/InsideOut/BaseMoose.pm [new file with mode: 0644]
t/lib/InsideOut/SubArray.pm [new file with mode: 0644]
t/lib/InsideOut/SubHash.pm [new file with mode: 0644]
t/lib/InsideOut/SubIO.pm [new file with mode: 0644]
t/lib/InsideOut/SubMoose.pm [new file with mode: 0644]
t/pod-coverage.t [new file with mode: 0644]
t/pod.t [new file with mode: 0644]
t/sub.t [new file with mode: 0644]

diff --git a/Changes b/Changes
new file mode 100644 (file)
index 0000000..5a77371
--- /dev/null
+++ b/Changes
@@ -0,0 +1,5 @@
+Revision history for MooseX-InsideOut
+
+0.001   Thu, 24 Jan 2008 13:17:54 -0500
+
+  * first release; thanks to stevan and mst for help
diff --git a/MANIFEST b/MANIFEST
new file mode 100644 (file)
index 0000000..b15f723
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,30 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+t/lib/InsideOut/SubHash.pm
+t/lib/InsideOut/BaseMoose.pm
+t/lib/InsideOut/SubIO.pm
+t/lib/InsideOut/BaseArray.pm
+t/lib/InsideOut/BaseHash.pm
+t/lib/InsideOut/BaseIO.pm
+t/lib/InsideOut/SubMoose.pm
+t/lib/InsideOut/SubArray.pm
+t/pod.t
+t/sub.t
+t/00-load.t
+t/pod-coverage.t
+lib/MooseX/InsideOut/Meta/Class.pm
+lib/MooseX/InsideOut/Meta/Instance.pm
+lib/MooseX/InsideOut.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install.pm
+inc/Module/AutoInstall.pm
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644 (file)
index 0000000..4ff0bcd
--- /dev/null
@@ -0,0 +1,16 @@
+use inc::Module::Install;
+
+name     'MooseX-InsideOut';
+all_from 'lib/MooseX/InsideOut.pm';
+author   'Hans Dieter Pearcey <hdp@pobox.com>';
+
+build_requires 'Test::More';
+
+requires 'Moose'                         => '0.35';
+requires 'Hash::Util::FieldHash::Compat' => 0;
+requires 'Task::Weaken'                  => 0;
+
+auto_install;
+
+WriteAll;
+
diff --git a/README b/README
new file mode 100644 (file)
index 0000000..ea967cb
--- /dev/null
+++ b/README
@@ -0,0 +1,40 @@
+MooseX-InsideOut
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+       perl Makefile.PL
+       make
+       make test
+       make install
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+    perldoc MooseX::InsideOut
+
+You can also look for information at:
+
+    RT, CPAN's request tracker
+        http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-InsideOut
+
+    AnnoCPAN, Annotated CPAN documentation
+        http://annocpan.org/dist/MooseX-InsideOut
+
+    CPAN Ratings
+        http://cpanratings.perl.org/d/MooseX-InsideOut
+
+    Search CPAN
+        http://search.cpan.org/dist/MooseX-InsideOut
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2008 Hans Dieter Pearcey
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
diff --git a/lib/MooseX/InsideOut.pm b/lib/MooseX/InsideOut.pm
new file mode 100644 (file)
index 0000000..4b54e13
--- /dev/null
@@ -0,0 +1,114 @@
+use strict;
+use warnings;
+
+package MooseX::InsideOut;
+
+use metaclass 'MooseX::InsideOut::Meta::Class';
+use Moose;
+
+1;
+__END__
+
+=head1 NAME
+
+MooseX::InsideOut - inside-out objects with Moose
+
+=head1 VERSION
+
+Version 0.001
+
+=cut
+
+our $VERSION = '0.001';
+
+=head1 SYNOPSIS
+
+  package My::Object;
+
+  use Moose;
+  extends 'MooseX::InsideOut';
+
+  # ... normal Moose functionality
+  # or ...
+
+  package My::Subclass;
+
+  use metaclass 'MooseX::InsideOut::Meta::Class';
+  use Moose;
+  extends 'Some::Other::Class;
+
+=head1 DESCRIPTION
+
+MooseX::InsideOut provides a metaclass and an instance metaclass for inside-out
+objects.
+
+You can use MooseX::InsideOut as a normal base class, as in the first example
+in the L</SYNOPSIS>.
+
+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.
+
+=head1 TODO
+
+=over
+
+=item * dumping (for debugging purposes)
+
+=item * serialization (for e.g. storable)
+
+=item * (your suggestions here)
+
+=back
+
+=head1 AUTHOR
+
+Hans Dieter Pearcey, C<< <hdp at pobox.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-moosex-insideout at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-InsideOut>.  I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc MooseX::InsideOut
+
+
+You can also look for information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-InsideOut>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/MooseX-InsideOut>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/MooseX-InsideOut>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/MooseX-InsideOut>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 Hans Dieter Pearcey.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
diff --git a/lib/MooseX/InsideOut/Meta/Class.pm b/lib/MooseX/InsideOut/Meta/Class.pm
new file mode 100644 (file)
index 0000000..e5984d3
--- /dev/null
@@ -0,0 +1,35 @@
+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
new file mode 100644 (file)
index 0000000..e722809
--- /dev/null
@@ -0,0 +1,89 @@
+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/t/00-load.t b/t/00-load.t
new file mode 100644 (file)
index 0000000..7fae638
--- /dev/null
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+       use_ok( 'MooseX::InsideOut' );
+}
+
+diag( "Testing MooseX::InsideOut $MooseX::InsideOut::VERSION, Perl $], $^X" );
diff --git a/t/lib/InsideOut/BaseArray.pm b/t/lib/InsideOut/BaseArray.pm
new file mode 100644 (file)
index 0000000..33098e4
--- /dev/null
@@ -0,0 +1,22 @@
+use strict;
+use warnings;
+
+package InsideOut::BaseArray;
+
+use constant FOO => 0;
+
+sub new {
+  my $class = shift;
+  my %p = @_;
+  my $self = bless [] => $class;
+  $self->[FOO] = $p{base_foo};
+  return $self;
+}
+
+sub base_foo {
+  my $self = shift;
+  if (@_) { $self->[FOO] = shift }
+  return $self->[FOO];
+}
+
+1;
diff --git a/t/lib/InsideOut/BaseHash.pm b/t/lib/InsideOut/BaseHash.pm
new file mode 100644 (file)
index 0000000..fa7abe5
--- /dev/null
@@ -0,0 +1,17 @@
+use strict;
+use warnings;
+
+package InsideOut::BaseHash;
+
+sub new {
+  my $class = shift;
+  bless {@_} => $class;
+}
+
+sub base_foo {
+  my $self = shift;
+  $self->{base_foo} = shift if @_;
+  return $self->{base_foo};
+}
+
+1;
diff --git a/t/lib/InsideOut/BaseIO.pm b/t/lib/InsideOut/BaseIO.pm
new file mode 100644 (file)
index 0000000..23311cc
--- /dev/null
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+
+package InsideOut::BaseIO;
+
+use Moose;
+extends 'MooseX::InsideOut';
+
+has base_foo => (
+  is => 'rw',
+);
+
+1;
diff --git a/t/lib/InsideOut/BaseMoose.pm b/t/lib/InsideOut/BaseMoose.pm
new file mode 100644 (file)
index 0000000..54b5636
--- /dev/null
@@ -0,0 +1,10 @@
+use strict;
+use warnings;
+
+package InsideOut::BaseMoose;
+
+use Moose;
+
+has base_foo => ( is => 'rw' );
+
+1;
diff --git a/t/lib/InsideOut/SubArray.pm b/t/lib/InsideOut/SubArray.pm
new file mode 100644 (file)
index 0000000..b2a68e8
--- /dev/null
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+
+package InsideOut::SubArray;
+
+use metaclass 'MooseX::InsideOut::Meta::Class';
+use Moose;
+extends 'InsideOut::BaseArray';
+
+has sub_foo => ( is => 'rw' );
+
+1;
+
diff --git a/t/lib/InsideOut/SubHash.pm b/t/lib/InsideOut/SubHash.pm
new file mode 100644 (file)
index 0000000..8ceb3ad
--- /dev/null
@@ -0,0 +1,12 @@
+use strict;
+use warnings;
+
+package InsideOut::SubHash;
+
+use metaclass 'MooseX::InsideOut::Meta::Class';
+use Moose;
+extends 'InsideOut::BaseHash';
+
+has sub_foo => ( is => 'rw' );
+
+1;
diff --git a/t/lib/InsideOut/SubIO.pm b/t/lib/InsideOut/SubIO.pm
new file mode 100644 (file)
index 0000000..0d74e80
--- /dev/null
@@ -0,0 +1,12 @@
+use strict;
+use warnings;
+
+package InsideOut::SubIO;
+
+use metaclass 'MooseX::InsideOut::Meta::Class';
+use Moose;
+extends 'InsideOut::BaseIO';
+
+has sub_foo => ( is => 'rw' );
+
+1;
diff --git a/t/lib/InsideOut/SubMoose.pm b/t/lib/InsideOut/SubMoose.pm
new file mode 100644 (file)
index 0000000..34e959a
--- /dev/null
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+
+package InsideOut::SubMoose;
+
+use metaclass 'MooseX::InsideOut::Meta::Class';
+use Moose;
+extends 'InsideOut::BaseMoose';
+
+has sub_foo => ( is => 'rw' );
+
+1;
+
diff --git a/t/pod-coverage.t b/t/pod-coverage.t
new file mode 100644 (file)
index 0000000..9124c55
--- /dev/null
@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+use Test::More;
+
+plan skip_all => "set \$ENV{TEST_POD} to test POD coverage"
+  unless $ENV{TEST_POD};
+
+# Ensure a recent version of Test::Pod::Coverage
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
+    if $@;
+
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
+# but older versions don't recognize some common documentation styles
+my $min_pc = 0.18;
+eval "use Pod::Coverage $min_pc";
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
+    if $@;
+
+all_pod_coverage_ok();
diff --git a/t/pod.t b/t/pod.t
new file mode 100644 (file)
index 0000000..ee8b18a
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,12 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();
diff --git a/t/sub.t b/t/sub.t
new file mode 100644 (file)
index 0000000..db19df9
--- /dev/null
+++ b/t/sub.t
@@ -0,0 +1,47 @@
+use strict;
+use warnings;
+use Test::More tests => 28;
+
+use lib 't/lib';
+my @classes = qw(IO Array Hash Moose);
+
+my %TODO = (
+#  Moose => "don't clobber superclass' meta's create_instance",
+);
+
+for my $c (@classes) {
+  my $base = "InsideOut::Base$c";
+  my $sub  = "InsideOut::Sub$c";
+  eval "require $base;1" or die $@;
+  eval "require $sub;1" or die $@;
+
+  my $obj = eval { $sub->new(base_foo => 17) };
+  is($@, "", "$c: no errors creating object");
+
+  {
+    local $TODO = $TODO{$c} if exists $TODO{$c};
+      
+    my $get = eval { $obj->base_foo };
+    is($@, "", "$c: no errors getting attribute");
+    is($get, 17, "$c: base_foo is 17");
+
+    my $set_base = eval {
+      $obj->base_foo(18);
+      $obj->base_foo;
+    };
+    is($@, "", "$c: no errors setting base class attribute");
+    is($set_base, 18, "$c: base_foo is 18");
+  }
+    
+  my $set_sub = eval {
+    $obj->sub_foo(23);
+    $obj->sub_foo;
+  };
+  is($@, "", "$c: no errors setting attribute");
+  is($set_sub, 23, "$c: sub_foo is 23");
+
+#  diag MooseX::InsideOut::Meta::Instance->__dump($obj);
+#  use Data::Dumper;
+#  diag Dumper($obj);
+
+}