--- /dev/null
+Revision history for MooseX-InsideOut
+
+0.001 Thu, 24 Jan 2008 13:17:54 -0500
+
+ * first release; thanks to stevan and mst for help
--- /dev/null
+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
--- /dev/null
+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;
+
--- /dev/null
+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.
+
--- /dev/null
+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
--- /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
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'MooseX::InsideOut' );
+}
+
+diag( "Testing MooseX::InsideOut $MooseX::InsideOut::VERSION, Perl $], $^X" );
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+use strict;
+use warnings;
+
+package InsideOut::BaseIO;
+
+use Moose;
+extends 'MooseX::InsideOut';
+
+has base_foo => (
+ is => 'rw',
+);
+
+1;
--- /dev/null
+use strict;
+use warnings;
+
+package InsideOut::BaseMoose;
+
+use Moose;
+
+has base_foo => ( is => 'rw' );
+
+1;
--- /dev/null
+use strict;
+use warnings;
+
+package InsideOut::SubArray;
+
+use metaclass 'MooseX::InsideOut::Meta::Class';
+use Moose;
+extends 'InsideOut::BaseArray';
+
+has sub_foo => ( is => 'rw' );
+
+1;
+
--- /dev/null
+use strict;
+use warnings;
+
+package InsideOut::SubHash;
+
+use metaclass 'MooseX::InsideOut::Meta::Class';
+use Moose;
+extends 'InsideOut::BaseHash';
+
+has sub_foo => ( is => 'rw' );
+
+1;
--- /dev/null
+use strict;
+use warnings;
+
+package InsideOut::SubIO;
+
+use metaclass 'MooseX::InsideOut::Meta::Class';
+use Moose;
+extends 'InsideOut::BaseIO';
+
+has sub_foo => ( is => 'rw' );
+
+1;
--- /dev/null
+use strict;
+use warnings;
+
+package InsideOut::SubMoose;
+
+use metaclass 'MooseX::InsideOut::Meta::Class';
+use Moose;
+extends 'InsideOut::BaseMoose';
+
+has sub_foo => ( is => 'rw' );
+
+1;
+
--- /dev/null
+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();
--- /dev/null
+#!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();
--- /dev/null
+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);
+
+}
projects / gitmo/MooseX-InsideOut.git / commitdiff