Skip to content
Browse files

Merge branch 'master' into xs

Conflicts:
	Makefile.PL
	cpanfile
	lib/mop.pm
	lib/mop/role.pm
  • Loading branch information...
2 parents 9989cdc + f47c72f commit 7eae4e9ad61c8a22debb8aab7ca853261a184a10 @doy doy committed
Showing with 2,161 additions and 576 deletions.
  1. +1 −2 .gitignore
  2. +13 −14 .travis/TravisHelper.pm
  3. +424 −0 META.json
  4. +66 −74 Makefile.PL
  5. +44 −34 cpanfile
  6. +58 −0 dist.ini
  7. +50 −0 inc/MakeMaker.pm
  8. +142 −116 lib/mop.pm
  9. +102 −22 lib/mop/attribute.pm
  10. +44 −5 lib/mop/class.pm
  11. +30 −5 lib/mop/internals/observable.pm
  12. +35 −5 lib/mop/internals/syntax.pm
  13. +79 −0 lib/mop/internals/util.pm
  14. +19 −3 lib/mop/manual/details/attributes.pod
  15. +20 −4 lib/mop/manual/details/classes.pod
  16. +19 −3 lib/mop/manual/details/methods.pod
  17. +190 −0 lib/mop/manual/details/mop.pod
  18. +20 −4 lib/mop/manual/details/roles.pod
  19. +56 −0 lib/mop/manual/details/traits.pod
  20. +21 −7 lib/mop/manual/intro.pod
  21. +23 −18 lib/mop/manual/tutorials/moose_to_mop.pod
  22. +51 −15 lib/mop/method.pm
  23. +31 −5 lib/mop/object.pm
  24. +98 −11 lib/mop/role.pm
  25. +228 −146 lib/mop/traits.pm
  26. +33 −5 lib/mop/traits/util.pm
  27. +3 −4 t/001-examples/003-binary-tree.t
  28. +1 −1 t/030-roles/005-multiple-classes.t
  29. +16 −16 t/100-internals/003-rebless.t
  30. +14 −14 t/100-internals/004-leaks.t
  31. +2 −1 t/150-parser-tests/002-basic.t
  32. +97 −0 t/200-meta/041-reapply-roles.t
  33. +92 −0 t/200-meta/200-mop.t
  34. +31 −0 t/200-meta/201-mop.t
  35. +2 −7 t/400-traits/004-weaken-trait.t
  36. +1 −1 t/400-traits/005-method-traits.t
  37. +1 −1 t/400-traits/006-overload-trait.t
  38. +1 −1 t/400-traits/008-lazy-trait.t
  39. +1 −1 t/400-traits/011-trait-order.t
  40. +1 −1 t/lib/Flack/Middleware.pm
  41. +1 −1 t/lib/Flack/Middleware/AccessLog.pm
  42. +0 −10 xt/release/eol.t
  43. +0 −10 xt/release/no-tabs.t
  44. +0 −9 xt/release/pod-syntax.t
View
3 .gitignore
@@ -1,10 +1,8 @@
__PLAN__.txt
cover_db
-META.*
MYMETA.*
Makefile
blib
-inc
pm_to_blib
MANIFEST
Makefile.old
@@ -13,6 +11,7 @@ MANIFEST.bak
*.sw[po]
.DS_Store
.build
+mop-*
*.bs
*.o
mop.c
View
27 .travis/TravisHelper.pm
@@ -6,10 +6,6 @@ our @EXPORT = qw(clone_repos installdeps test);
use Cwd 'cwd';
-# note: there are a couple shortcuts in here that assume that p5-mop-redux
-# itself has no author tests and doesn't use dzil. if either of those stop
-# being true, a few things will probably need to be adjusted.
-
my $mop_dir = cwd;
# XXX we should probably not be setting this while testing p5-mop-redux itself,
# but i don't think it will hurt anything at the moment
@@ -78,14 +74,14 @@ sub clone_repos {
sub installdeps {
each_dir {
- if (-e 'Makefile.PL' || -e 'Build.PL') {
- _cpanm(qw(cpanm --installdeps -q --notest --with-develop .));
- }
- elsif (-e 'dist.ini') {
+ if (-e 'dist.ini' && !/Plack/) {
_cpanm(qw(cpanm -q --notest Dist::Zilla)) ||
_cpanm("dzil authordeps --missing | cpanm -q --notest") ||
_cpanm("dzil listdeps --author --missing | grep -v 'find abstract in' | grep -v '^mop\$' | cpanm -q --notest");
}
+ elsif (-e 'Makefile.PL' || -e 'Build.PL') {
+ _cpanm(qw(cpanm --installdeps -q --notest --with-develop .));
+ }
else {
warn "Don't know how to install deps";
warn "Cannot find any of Build.PL, Makefile.PL, or dist.ini";
@@ -99,24 +95,27 @@ sub test {
each_dir {
# these fail release tests
local $ENV{RELEASE_TESTING}
- if /Plack|http-headers-actionpack|BreadBoard/;
+ if /Plack|http-headers-actionpack|BreadBoard|Action-Retry/;
my $failed = 0;
- if (-e 'Build.PL') {
+ if (-e 'dist.ini' && !/Plack/) {
+ my $cmd = "dzil test";
+ $cmd .= ' --all'
+ unless /Plack|http-headers-actionpack|BreadBoard|Action-Retry/;
+ $failed ||= _system($cmd);
+ }
+ elsif (-e 'Build.PL') {
$failed ||= _system("perl Build.PL && ./Build test");
}
elsif (-e 'Makefile.PL') {
$failed ||= _system("perl Makefile.PL && make test");
}
- elsif (-e 'dist.ini') {
- $failed ||= _system("dzil test");
- }
else {
$failed ||= _system("prove -lr t");
}
- if (-e 'xt') {
+ if (-e 'xt' && !-e 'dist.ini') {
$failed ||= _system("prove -lr xt");
}
View
424 META.json
@@ -0,0 +1,424 @@
+{
+ "abstract" : "A new object system for Perl 5",
+ "author" : [
+ "Stevan Little <stevan.little@iinteractive.com>",
+ "Jesse Luehrs <doy@tozt.net>"
+ ],
+ "dynamic_config" : 0,
+ "generated_by" : "Dist::Zilla version 4.300039, CPAN::Meta::Converter version 2.132140",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "mop",
+ "no_index" : {
+ "namespace" : [
+ "mop::internals"
+ ]
+ },
+ "prereqs" : {
+ "configure" : {
+ "requires" : {
+ "Devel::CallParser" : "0",
+ "ExtUtils::MakeMaker" : "6.30"
+ }
+ },
+ "develop" : {
+ "requires" : {
+ "Devel::StackTrace" : "0",
+ "Moose" : "0",
+ "Moose::Util::TypeConstraints" : "0",
+ "Package::Stash::XS" : "0.27",
+ "Path::Class" : "0",
+ "Pod::Coverage::TrustPod" : "0",
+ "Test::EOL" : "0",
+ "Test::NoTabs" : "0",
+ "Test::Pod" : "1.41",
+ "Test::Pod::Coverage" : "1.08"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "B::Hooks::EndOfScope" : "0",
+ "Carp" : "0",
+ "Devel::CallParser" : "0",
+ "Hash::Util::FieldHash" : "0",
+ "Parse::Keyword" : "0",
+ "Scalar::Util" : "0",
+ "Scope::Guard" : "0",
+ "Sub::Name" : "0",
+ "Variable::Magic" : "0",
+ "XSLoader" : "0",
+ "mro" : "0",
+ "overload" : "0",
+ "parent" : "0",
+ "perl" : "v5.16.0",
+ "strict" : "0",
+ "twigils" : "0.04",
+ "version" : "0",
+ "warnings" : "0"
+ }
+ },
+ "test" : {
+ "requires" : {
+ "B::Deparse" : "0",
+ "File::Find" : "0",
+ "File::Temp" : "0",
+ "FindBin" : "0",
+ "IO::Handle" : "0",
+ "Test::More" : "0.88",
+ "if" : "0",
+ "lib" : "0"
+ }
+ }
+ },
+ "provides" : {
+ "mop" : {
+ "file" : "lib/mop.pm",
+ "version" : "0.01"
+ },
+ "mop::attribute" : {
+ "file" : "lib/mop/attribute.pm",
+ "version" : "0.01"
+ },
+ "mop::class" : {
+ "file" : "lib/mop/class.pm",
+ "version" : "0.01"
+ },
+ "mop::manual::details::attributes" : {
+ "file" : "lib/mop/manual/details/attributes.pod",
+ "version" : "0.01"
+ },
+ "mop::manual::details::classes" : {
+ "file" : "lib/mop/manual/details/classes.pod",
+ "version" : "0.01"
+ },
+ "mop::manual::details::methods" : {
+ "file" : "lib/mop/manual/details/methods.pod",
+ "version" : "0.01"
+ },
+ "mop::manual::details::mop" : {
+ "file" : "lib/mop/manual/details/mop.pod",
+ "version" : "0.01"
+ },
+ "mop::manual::details::roles" : {
+ "file" : "lib/mop/manual/details/roles.pod",
+ "version" : "0.01"
+ },
+ "mop::manual::details::traits" : {
+ "file" : "lib/mop/manual/details/traits.pod",
+ "version" : "0.01"
+ },
+ "mop::manual::intro" : {
+ "file" : "lib/mop/manual/intro.pod",
+ "version" : "0.01"
+ },
+ "mop::manual::tutorials::moose_to_mop" : {
+ "file" : "lib/mop/manual/tutorials/moose_to_mop.pod",
+ "version" : "0.01"
+ },
+ "mop::method" : {
+ "file" : "lib/mop/method.pm",
+ "version" : "0.01"
+ },
+ "mop::object" : {
+ "file" : "lib/mop/object.pm",
+ "version" : "0.01"
+ },
+ "mop::role" : {
+ "file" : "lib/mop/role.pm",
+ "version" : "0.01"
+ },
+ "mop::traits" : {
+ "file" : "lib/mop/traits.pm",
+ "version" : "0.01"
+ },
+ "mop::traits::util" : {
+ "file" : "lib/mop/traits/util.pm",
+ "version" : "0.01"
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "bugtracker" : {
+ "web" : "https://github.com/stevan/p5-mop-redux/issues"
+ },
+ "homepage" : "http://metacpan.org/release/mop",
+ "repository" : {
+ "type" : "git",
+ "url" : "git://github.com/stevan/p5-mop-redux.git",
+ "web" : "https://github.com/stevan/p5-mop-redux"
+ }
+ },
+ "version" : "0.01",
+ "x_Dist_Zilla" : {
+ "perl" : {
+ "version" : "5.018001"
+ },
+ "plugins" : [
+ {
+ "class" : "Dist::Zilla::Plugin::FileFinder::Filter",
+ "name" : "PPIHack",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::Prereqs",
+ "config" : {
+ "Dist::Zilla::Plugin::Prereqs" : {
+ "phase" : "test",
+ "type" : "requires"
+ }
+ },
+ "name" : "@Filter/TestMoreDoneTesting",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::GatherDir",
+ "name" : "@Filter/GatherDir",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::PruneCruft",
+ "name" : "@Filter/PruneCruft",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::ManifestSkip",
+ "name" : "@Filter/ManifestSkip",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::MetaYAML",
+ "name" : "@Filter/MetaYAML",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::License",
+ "name" : "@Filter/License",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::RunExtraTests",
+ "name" : "@Filter/RunExtraTests",
+ "version" : "0.011"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::ExecDir",
+ "name" : "@Filter/ExecDir",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::ShareDir",
+ "name" : "@Filter/ShareDir",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "inc::MakeMaker",
+ "name" : "@Filter/=inc::MakeMaker",
+ "version" : null
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::Manifest",
+ "name" : "@Filter/Manifest",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::TestRelease",
+ "name" : "@Filter/TestRelease",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::ConfirmRelease",
+ "name" : "@Filter/ConfirmRelease",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::MetaConfig",
+ "name" : "@Filter/MetaConfig",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::MetaJSON",
+ "name" : "@Filter/MetaJSON",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::NextRelease",
+ "name" : "@Filter/NextRelease",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::CheckChangesHasContent",
+ "name" : "@Filter/CheckChangesHasContent",
+ "version" : "0.006"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::PodCoverageTests",
+ "name" : "@Filter/PodCoverageTests",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::PodSyntaxTests",
+ "name" : "@Filter/PodSyntaxTests",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::NoTabsTests",
+ "name" : "@Filter/NoTabsTests",
+ "version" : "0.01"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::EOLTests",
+ "name" : "@Filter/EOLTests",
+ "version" : "0.02"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::Test::Compile",
+ "name" : "@Filter/Test::Compile",
+ "version" : "2.002"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::Metadata",
+ "name" : "@Filter/Metadata",
+ "version" : "3.03"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::MetaResources",
+ "name" : "@Filter/MetaResources",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::Git::Check",
+ "name" : "@Filter/Git::Check",
+ "version" : "2.013"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::Git::Commit",
+ "name" : "@Filter/Git::Commit",
+ "version" : "2.013"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::Git::Tag",
+ "name" : "@Filter/Git::Tag",
+ "version" : "2.013"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::Git::NextVersion",
+ "name" : "@Filter/Git::NextVersion",
+ "version" : "2.013"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::ContributorsFromGit",
+ "name" : "@Filter/ContributorsFromGit",
+ "version" : "0.006"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::MetaProvides::Package",
+ "name" : "@Filter/MetaProvides::Package",
+ "version" : "1.14000002"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::UploadToCPAN",
+ "name" : "@Filter/UploadToCPAN",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::AutoPrereqs",
+ "name" : "AutoPrereqs",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::MetaNoIndex",
+ "name" : "MetaNoIndex",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::Prereqs",
+ "config" : {
+ "Dist::Zilla::Plugin::Prereqs" : {
+ "phase" : "develop",
+ "type" : "requires"
+ }
+ },
+ "name" : "DevelopRequires",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::Prereqs",
+ "config" : {
+ "Dist::Zilla::Plugin::Prereqs" : {
+ "phase" : "configure",
+ "type" : "requires"
+ }
+ },
+ "name" : "ConfigureRequires",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::ContributorsFromGit",
+ "name" : "ContributorsFromGit",
+ "version" : "0.006"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::CPANFile",
+ "name" : "CPANFile",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::CopyFilesFromBuild",
+ "name" : "CopyFilesFromBuild",
+ "version" : "0.103510"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::FinderCode",
+ "name" : ":InstallModules",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::FinderCode",
+ "name" : ":IncModules",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::FinderCode",
+ "name" : ":TestFiles",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::FinderCode",
+ "name" : ":ExecFiles",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::FinderCode",
+ "name" : ":ShareFiles",
+ "version" : "4.300039"
+ },
+ {
+ "class" : "Dist::Zilla::Plugin::FinderCode",
+ "name" : ":MainModule",
+ "version" : "4.300039"
+ }
+ ],
+ "zilla" : {
+ "class" : "Dist::Zilla::Dist::Builder",
+ "config" : {
+ "is_trial" : "0"
+ },
+ "version" : "4.300039"
+ }
+ },
+ "x_authority" : "cpan:STEVAN",
+ "x_contributors" : [
+ "Chris Prather <chris@prather.org>",
+ "Damien Krotkine <dkrotkine@weborama.com>",
+ "David Golden <dagolden@cpan.org>",
+ "Florian Ragwitz <rafl@debian.org>",
+ "Steffen Mueller <smueller@cpan.org>",
+ "Toby Inkster <mail@tobyinkster.co.uk>"
+ ]
+}
+
View
140 Makefile.PL
@@ -1,77 +1,57 @@
-
-use 5.016000;
-
+# This Makefile.PL for was generated by Dist::Zilla.
+# Don't edit it but the dist.ini used to construct it.
+BEGIN { require v5.16.0; }
use strict;
use warnings;
-
use ExtUtils::MakeMaker 6.30;
-use Devel::CallParser;
-
-{
- open my $fh, '>', 'callparser1.h' or die $!;
- print { $fh } Devel::CallParser::callparser1_h() or die $!;
- close $fh or die $!;
-}
-
my %WriteMakefileArgs = (
- 'ABSTRACT' => 'A meta-object protocol for Perl 5',
- 'DISTNAME' => 'p5-mop-redux',
- 'AUTHOR' => 'Stevan Little <stevan.little@iinterative.com>',
- 'LICENSE' => 'perl',
- 'NAME' => 'mop',
- 'VERSION' => '0.01',
- 'BUILD_REQUIRES' => {},
- 'CONFIGURE_REQUIRES' => { 'ExtUtils::MakeMaker' => '6.30' },
- 'EXE_FILES' => [],
- 'PREREQ_PM' => {
- # core
- 'Carp' => 0,
- 'Hash::Util::FieldHash' => 0,
- 'Scalar::Util' => 0,
- 'mro' => 0,
- 'overload' => 0,
- 'parent' => 0,
- 'strict' => 0,
- 'version' => 0,
- 'warnings' => 0,
-
- # parser
- 'B::Hooks::EndOfScope' => 0,
- 'Parse::Keyword' => 0.04,
- 'Scope::Guard' => 0,
- 'twigils' => 0,
- 'Variable::Magic' => 0,
- 'Devel::CallParser' => 0,
+ 'ABSTRACT' => 'A new object system for Perl 5',
+ 'AUTHOR' => 'Stevan Little <stevan.little@iinteractive.com>, Jesse Luehrs <doy@tozt.net>',
+ 'BUILD_REQUIRES' => {
+ 'B::Deparse' => '0',
+ 'File::Find' => '0',
+ 'File::Temp' => '0',
+ 'FindBin' => '0',
+ 'IO::Handle' => '0',
+ 'Test::More' => '0.88',
+ 'if' => '0',
+ 'lib' => '0'
+ },
+ 'CONFIGURE_REQUIRES' => {
+ 'Devel::CallParser' => '0',
+ 'ExtUtils::MakeMaker' => '6.30'
},
- 'TEST_REQUIRES' => {
- # core
- 'B::Deparse' => 0,
- 'FindBin' => 0,
- 'IO::Handle' => 0,
- 'Test::More' => 0.88,
- 'if' => 0,
- 'lib' => 0,
+ 'DISTNAME' => 'mop',
+ 'EXE_FILES' => [],
+ 'LICENSE' => 'perl',
+ 'NAME' => 'mop',
+ 'PREREQ_PM' => {
+ 'B::Hooks::EndOfScope' => '0',
+ 'Carp' => '0',
+ 'Devel::CallParser' => '0',
+ 'Hash::Util::FieldHash' => '0',
+ 'Parse::Keyword' => '0',
+ 'Scalar::Util' => '0',
+ 'Scope::Guard' => '0',
+ 'Sub::Name' => '0',
+ 'Variable::Magic' => '0',
+ 'XSLoader' => '0',
+ 'mro' => '0',
+ 'overload' => '0',
+ 'parent' => '0',
+ 'strict' => '0',
+ 'twigils' => '0.04',
+ 'version' => '0',
+ 'warnings' => '0'
},
+ 'VERSION' => '0.01',
'test' => {
- 'TESTS' => 't/*.t t/*/*.t t/300-ext/*/*.t'
+ 'TESTS' => 't/*.t t/001-examples/*.t t/010-basics/*.t t/020-methods/*.t t/030-roles/*.t t/050-non-mop-integration/*.t t/100-internals/*.t t/110-oddities/*.t t/120-bugs/*.t t/150-parser-tests/*.t t/200-meta/*.t t/300-ext/Option/*.t t/300-ext/Test-BuilderX/*.t t/400-traits/*.t'
}
);
-unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
- my $tr = delete $WriteMakefileArgs{TEST_REQUIRES};
- my $br = $WriteMakefileArgs{BUILD_REQUIRES};
- for my $mod ( keys %$tr ) {
- if ( exists $br->{$mod} ) {
- $br->{$mod} = $tr->{$mod} if $tr->{$mod} > $br->{$mod};
- }
- else {
- $br->{$mod} = $tr->{$mod};
- }
- }
-}
-
unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) {
my $br = delete $WriteMakefileArgs{BUILD_REQUIRES};
my $pp = $WriteMakefileArgs{PREREQ_PM};
@@ -89,20 +69,32 @@ delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
if ($ENV{RELEASE_TESTING}) {
- $WriteMakefileArgs{TEST_REQUIRES} = {
- %{ $WriteMakefileArgs{TEST_REQUIRES} },
- 'Devel::StackTrace' => 0,
- 'Moose' => 0,
- 'Moose::Util::TypeConstraints' => 0,
- 'Path::Class' => 0,
- 'Package::Stash::XS' => 0.27,
- 'Test::EOL' => 0,
- 'Test::NoTabs' => 0,
- 'Test::Pod' => 1.41,
- };
+ my %DEVELOP_REQUIRES = (
+ "Devel::StackTrace" => 0,
+ "Moose" => 0,
+ "Moose::Util::TypeConstraints" => 0,
+ "Package::Stash::XS" => "0.27",
+ "Path::Class" => 0,
+ "Pod::Coverage::TrustPod" => 0,
+ "Test::EOL" => 0,
+ "Test::NoTabs" => 0,
+ "Test::Pod" => "1.41",
+ "Test::Pod::Coverage" => "1.08"
+ );
+
+ $WriteMakefileArgs{BUILD_REQUIRES} = {
+ %{ $WriteMakefileArgs{BUILD_REQUIRES} },
+ %DEVELOP_REQUIRES,
+ };
}
-WriteMakefile(%WriteMakefileArgs);
+use Devel::CallParser;
+{
+ open my $fh, '>', 'callparser1.h' or die $!;
+ print { $fh } Devel::CallParser::callparser1_h() or die $!;
+ close $fh or die $!;
+}
+WriteMakefile(%WriteMakefileArgs);
View
78 cpanfile
@@ -1,37 +1,47 @@
-# core
-requires 'Carp' => 0;
-requires 'Hash::Util::FieldHash' => 0;
-requires 'Scalar::Util' => 0;
-requires 'mro' => 0;
-requires 'overload' => 0;
-requires 'parent' => 0;
-requires 'perl' => 5.016;
-requires 'strict' => 0;
-requires 'version' => 0;
-requires 'warnings' => 0;
+requires "B::Hooks::EndOfScope" => "0";
+requires "Carp" => "0";
+requires "Devel::CallParser" => "0";
+requires "Hash::Util::FieldHash" => "0";
+requires "Parse::Keyword" => "0";
+requires "Scalar::Util" => "0";
+requires "Scope::Guard" => "0";
+requires "Sub::Name" => "0";
+requires "Variable::Magic" => "0";
+requires "XSLoader" => "0";
+requires "mro" => "0";
+requires "overload" => "0";
+requires "parent" => "0";
+requires "perl" => "v5.16.0";
+requires "strict" => "0";
+requires "twigils" => "0.04";
+requires "version" => "0";
+requires "warnings" => "0";
-build_requires 'B::Deparse' => 0;
-build_requires 'FindBin' => 0;
-build_requires 'IO::Handle' => 0;
-build_requires 'Test::More' => 0.88;
-build_requires 'if' => 0;
-build_requires 'lib' => 0;
-build_requires 'Devel::CallParser' => 0;
+on 'test' => sub {
+ requires "B::Deparse" => "0";
+ requires "File::Find" => "0";
+ requires "File::Temp" => "0";
+ requires "FindBin" => "0";
+ requires "IO::Handle" => "0";
+ requires "Test::More" => "0.88";
+ requires "if" => "0";
+ requires "lib" => "0";
+};
-# parser
-requires 'B::Hooks::EndOfScope' => 0;
-requires 'Parse::Keyword' => 0.04;
-requires 'Scope::Guard' => 0;
-requires 'twigils' => 0;
-requires 'Variable::Magic' => 0;
-requires 'Devel::CallParser' => 0;
+on 'configure' => sub {
+ requires "Devel::CallParser" => "0";
+ requires "ExtUtils::MakeMaker" => "6.30";
+};
-# other
-author_requires 'Devel::StackTrace' => 0;
-author_requires 'Moose' => 0;
-author_requires 'Moose::Util::TypeConstraints' => 0;
-author_requires 'Package::Stash::XS' => 0.27;
-author_requires 'Path::Class' => 0;
-author_requires 'Test::EOL' => 0;
-author_requires 'Test::NoTabs' => 0;
-author_requires 'Test::Pod' => 1.41;
+on 'develop' => sub {
+ requires "Devel::StackTrace" => "0";
+ requires "Moose" => "0";
+ requires "Moose::Util::TypeConstraints" => "0";
+ requires "Package::Stash::XS" => "0.27";
+ requires "Path::Class" => "0";
+ requires "Pod::Coverage::TrustPod" => "0";
+ requires "Test::EOL" => "0";
+ requires "Test::NoTabs" => "0";
+ requires "Test::Pod" => "1.41";
+ requires "Test::Pod::Coverage" => "1.08";
+};
View
58 dist.ini
@@ -0,0 +1,58 @@
+name = mop
+author = Stevan Little <stevan.little@iinteractive.com>
+author = Jesse Luehrs <doy@tozt.net>
+license = Perl_5
+copyright_holder = Infinity Interactive
+
+; PPI explodes on files with non-ascii identifiers (sigh)
+[FileFinder::Filter / PPIHack]
+finder = :TestFiles
+skip = t/150-parser-tests/007-utf8.t
+
+[@Filter]
+-bundle = @DOY
+-remove = Readme
+-remove = PodWeaver
+-remove = PkgVersion
+-remove = Authority
+:version = 0.14
+dist = mop
+repository = github
+github_user = stevan
+github_name = p5-mop-redux
+awesome = =inc::MakeMaker
+Metadata_x_authority = cpan:STEVAN
+GatherDir_exclude_match = Makefile.PL|cpanfile|META.json
+
+[AutoPrereqs]
+test_finder = PPIHack
+skip = ^Test::BuilderX
+skip = ^Devel::StackTrace
+skip = ^Moose\b
+skip = ^My(Array|Custom|Glob|Hash|Scalar)
+skip = ^Package::Stash
+skip = ^Path::Class
+
+[MetaNoIndex]
+namespace = mop::internals
+
+[Prereqs / DevelopRequires]
+Devel::StackTrace = 0
+Moose = 0
+Moose::Util::TypeConstraints = 0
+Package::Stash::XS = 0.27
+Path::Class = 0
+Test::EOL = 0
+Test::NoTabs = 0
+
+[Prereqs / ConfigureRequires]
+Devel::CallParser = 0
+
+[ContributorsFromGit]
+
+[CPANFile]
+
+[CopyFilesFromBuild]
+copy = Makefile.PL
+copy = cpanfile
+copy = META.json
View
50 inc/MakeMaker.pm
@@ -0,0 +1,50 @@
+package inc::MakeMaker;
+use Moose;
+
+extends 'Dist::Zilla::Plugin::MakeMaker::Awesome';
+
+around _build_MakeFile_PL_template => sub {
+ my $orig = shift;
+ my $self = shift;
+
+ my $dumper = Data::Dumper->new(
+ [ $self->zilla->prereqs->requirements_for(qw(develop requires))->as_string_hash ],
+ [ '*DEVELOP_REQUIRES' ]
+ );
+ $dumper->Sortkeys(1);
+ $dumper->Indent(1);
+ $dumper->Useqq(1);
+ $dumper->Pad(' ');
+
+ my $prereqs = $dumper->Dump =~ s/^\s*//r;
+
+ my $fixup_prereqs = <<PREREQS;
+if (\$ENV{RELEASE_TESTING}) {
+ my $prereqs
+ \$WriteMakefileArgs{BUILD_REQUIRES} = {
+ %{ \$WriteMakefileArgs{BUILD_REQUIRES} },
+ %DEVELOP_REQUIRES,
+ };
+}
+PREREQS
+
+ my $callparser_h = <<CALLPARSER_H;
+use Devel::CallParser;
+
+{
+ open my \$fh, '>', 'callparser1.h' or die \$!;
+ print { \$fh } Devel::CallParser::callparser1_h() or die \$!;
+ close \$fh or die \$!;
+}
+CALLPARSER_H
+
+ my $template = $self->$orig(@_);
+ $template =~ s/(WriteMakefile\()/$fixup_prereqs\n$callparser_h\n$1/;
+
+ return $template;
+};
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
View
258 lib/mop.pm
@@ -6,6 +6,7 @@ use warnings;
use overload ();
use Scalar::Util;
+use Sub::Name ();
our $VERSION = '0.01';
our $AUTHORITY = 'cpan:STEVAN';
@@ -123,7 +124,7 @@ sub rebless {
@into_isa = grep { defined } map { meta($_) } @into_isa;
for my $attr (map { $_->attributes } @from_isa) {
- delete $attr->storage->{$object};
+ $attr->remove_data_in_slot_for($object);
}
bless($object, $into);
@@ -309,7 +310,7 @@ __END__
=head1 NAME
-mop - A meta-object protocol for Perl 5
+mop - A new object system for Perl 5
=head1 VERSION
@@ -337,180 +338,205 @@ version 0.01
}
}
-=head1 DESCRIPTION
+=head1 STATEMENT OF INTENT
-This is a prototype for a new object system for Perl 5.
+This is a prototype for a new object system for Perl 5, it is our
+intent to try and get this into the core of Perl 5. This is being
+released to CPAN so that the community at large can test it out
+and provide feedback.
-=head1 The MOP
+It can B<not> be overstated that this is a 0.01 prototype, which
+means that nothing here is final and everything could change.
+That said we are quite happy with the current state and after
+several months of working with it, feel that it is solid enough
+to go out to CPAN and withstand the cold harsh light of day.
- class mop::object {
- method new (%args) { ... }
- method clone (%args) { ... }
+=head1 FAQs
- method BUILDALL ($args) { ... }
+=head2 How can I help?
- method can ($name) { ... }
- method isa ($class) { ... }
- method does ($role) { ... }
- method DOES ($name) { ... }
+Thanks for asking, there are several things that you can do to
+help!
- method DESTROY { ... }
- }
-
- class mop::attribute extends mop::object {
- has $!name is ro;
- has $!default;
- has $!storage is ro = {};
- has $!associated_meta is ro;
- has $!original_id;
+=head3 Contributing/reviewing documentation
- has $!callbacks;
+Documentation is not one of our strong suits, any help on this
+would be very much appreciated. Especially documetation written
+from the perspective of users without prior knowledge of MOPs
+and/or Moose.
- method BUILD { ... }
+Please send any and all patches as pull requests to our
+L<repository on github|https://github.com/stevan/p5-mop-redux>.
- method key_name { ... }
+=head3 Porting a module
- method has_default { ... }
- method get_default { ... }
+Early on in the development of this we started porting existing
+Perl OO modules to use the mop. This proved to be a really
+excellent way of uncovering edge cases and issues. We currently
+have 9 ported modules in our L<Travis|https://travis-ci.org>
+smoke test and are always looking for more.
- method set_associated_meta ($meta) { ... }
+If you do port something, please let us know via the
+L<github issue tracker|https://github.com/stevan/p5-mop-redux/issues>
+so that we can add it to our smoke tests.
- method conflicts_with ($attr) { ... }
+=head3 Writing a module
- method fetch_data_in_slot_for ($instance) { ... }
- method store_data_in_slot_for ($instance, $data) { ... }
- method store_default_in_slot_for ($instance) { ... }
+Porting existing modules to the mop is interesting, but we are
+also interested in having people try it out from scratch. We
+currently only have 1 original module in our L<Travis|https://travis-ci.org>
+smoke test and are always looking for more.
- method bind ($event_name, $cb) { ... }
- method unbind ($event_name, $cb) { ... }
- method fire ($event_name) { ... }
- }
+If you do write something using the mop, please let us know via the
+L<github issue tracker|https://github.com/stevan/p5-mop-redux/issues>
+so that we can add it to our smoke tests.
- class mop::method extends mop::object {
- has $!name is ro;
- has $!body is ro;
- has $!associated_meta is ro;
- has $!original_id;
+=head3 Speak to us
- has $!callbacks;
+We are always open for a reasonable, civil discourse on what it
+is we are trying to do here. If you have ideas or issues with
+anything you see here please submit your thoughts via the
+L<github issue tracker|https://github.com/stevan/p5-mop-redux/issues>
+so that it can be discussed.
- method BUILD { ... }
+Trolls are welcome, but beware, we may try to
+L<hug you|http://pugs.blogs.com/audrey/2009/08/my-hobby-troll-hugging.html>!
- method execute ($invocant, $args) { ... }
+=head3 Hack with us
- method set_associated_meta ($meta) { ... }
+There are still many things to be done, if you want to help we
+would love to have it. Please stop by and see us in the #p5-mop
+channel on irc.perl.org to discuss. Specifically we are looking for
+XS hacker and perlguts specialists.
- method conflicts_with ($method) { ... }
+=head3 Spread the word
- method bind ($event_name, $cb) { ... }
- method unbind ($event_name, $cb) { ... }
- method fire ($event_name) { ... }
- }
+The Perl community is a notorious echo chamber, itself filled with
+smaller, more specific, echo chambers (OMG - it's echo chambers all
+the way down!). If you are reading this, clearly you are inside, or
+in the vicinity of, this particular echo chamber and so please if
+you like what we are doing, spread the word. Write a blog post,
+send a tweet into the ether, give a talk at your local tech meetup,
+anything that helps get the word out is a good thing.
- class mop::role extends mop::object {
- has $!name is ro;
- has $!version is ro;
- has $!authority is ro;
+Side note: We have been using the #p5mop hashtag on twitter and in
+blog posts, please continue that trend so things can be easily
+aggregated.
- has $!roles is ro = [];
- has $!attributes = {};
- has $!methods = {};
- has $!required_methods = {};
+=head2 Why aren't you supporting @features from $my_favorite_oo_module?
- has $!callbacks;
+It is our intention to keep the core mop as simple as possible
+and to allow for users to easily extend it to support their
+favorite features. If you have any questions about writing said
+extensions or feel that we are really should support a given
+feature in core, please submit an issue to the
+L<github issue tracker|https://github.com/stevan/p5-mop-redux/issues>
+so that it can be discussed.
- method BUILD { ... }
+=head2 Why are you messing up Perl, I like it how it is!?!?!
- method add_role ($role) { ... }
- method does_role ($name) { ... }
+We are absolutely 100% B<NOT> going to remove B<any> of the existing OO
+support in Perl I<FULL STOP>.
- method attribute_class { 'mop::attribute' }
+We are developing this feature fully in keeping with the long standing
+commitment to backward compatibility that Perl is famous for. We are
+also committed to making this new object system work as seamlessly as
+possible with all of the existing Perl OO features.
- method attributes { ... }
- method attribute_map { ... }
+=head2 Why is it so slow?
- method add_attribute ($attr) { ... }
- method get_attribute ($name) { ... }
- method has_attribute ($name) { ... }
+It is a prototype, first we had to get it right, next we will make
+it fast. We have a number of planned optimizations in the works and
+are confident that ultimately speed will not be an issue.
- method method_class { 'mop::method' }
+=head2 Can I use this in production?
- method methods { ... }
- method method_map { ... }
+Probably not a good idea, but hey, it's your codebase. If you are crazy
+enough to do this, please let us know how it goes!
- method add_method ($attr) { ... }
- method get_method ($name) { ... }
- method has_method ($name) { ... }
+=head2 What version of Perl do you expect this to ship with?
- method required_methods { ... }
- method required_method_map { ... }
+Well, we would like it to be included as experimental in 5.22, but
+that might be a little tight, time will tell. In the meantime we will
+try and keep supporting a CPAN version as long as it is possible.
- method add_required_method ($required_method) { ... }
- method remove_required_method ($required_method) { ... }
- method requires_method ($name) { ... }
+=head1 PUBLIC UTILITY FUNCTIONS
- method bind ($event_name, $cb) { ... }
- method unbind ($event_name, $cb) { ... }
- method fire ($event_name) { ... }
+The following is a list of public utility functions to
+be used along with the MOP.
- sub FINALIZE { ... }
- }
+=head2 meta($obj_or_class_name)
- # 'with mop::role' is odd because mop::role is a class, but it works as
- # you would expect
- class mop::class extends mop::object with mop::role {
- has $!superclass is ro;
- has $!is_abstract is ro;
- has $!instance_generator is ro = sub { \(my $anon) };
+Given an object instance or a class name, this will return
+the meta-object associated with it. If there is no meta-object
+associated with it, meaning it is not a MOP class or role,
+then undef will be returned.
- method BUILD { ... }
+=head2 id($obj)
- method make_class_abstract { ... }
+Given an instance this will return the unique ID given
+to that instance. This ID is the key used throughout many
+of the MOP internals to identify this instance.
- method new_instance { ... }
- method clone_instance { ... }
+=head2 is_mop_object($obj)
- method set_instance_generator ($generator) { ... }
- method create_fresh_instance_structure { ... }
- }
+This predicate will return true of the instance if a MOP
+object, and false otherwise.
-=head1 BOOTSTRAPPING GOALS
+=head2 dump_object($obj)
- Class is an instance of Class
- Object is an instance of Class
- Class is a subclass of Object
+This is a simple utility function that takes an instance
+and returns a HASH ref dump of the data contained within
+the instance. This is necessary because MOP instances are
+opaque and cannot be dumped using the existing tools
+(ex: Data::Dumper, etc.).
- Class does Role
- Role is an instance of Class
- Role does Role
+NOTE: This is a temporary situation, once this system is
+accepted into core, we expect that the tools will add
+support accordingly.
-=head1 FUNCTIONS
+=head1 OTHER FUNCTIONS
-=head2 meta($obj_or_class_name)
+The following are functions that are unlikely to be useful
+to any but the most daring of users. Use with great caution!
-=head2 remove_meta($class_name)
+=head2 apply_metaclass($obj, $metaclass_name_or_instance)
-=head2 id($obj)
+Given an instance and a class name, this will perform all
+the necessary metaclass compatibility checks and then
+rebless the instance accordingly.
-=head2 is_mop_object($obj)
+=head2 rebless($obj, $class_name)
-=head2 apply_metaclass($obj, $metaclass_name_or_instance)
+Given an instance and a class name, this will handle
+reblessing the instance into the class and assure that
+all the correct initializations are done.
-=head2 rebless($obj, $class_name)
+=head2 remove_meta($class_name)
-=head2 dump_object($obj)
+This will remove the metaclass associated with a given
+C<$class_name>, after this C<meta> will return undef.
=head2 initialize()
+This will bootstrap the MOP, you really should never call this
+we will do it for you.
+
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
-exception. If you find a bug please either email me, or add the bug
-to cpan-RT.
+Since this module is still under development we would prefer to not
+use the RT bug queue and instead use the built in issue tracker on
+L<Github|http://www.github.com>.
+
+=head2 L<Git Repository|https://github.com/stevan/p5-mop-redux>
+
+=head2 L<Issue Tracker|https://github.com/stevan/p5-mop-redux/issues>
=head1 AUTHOR
-Stevan Little <stevan@iinteractive.com>
+Stevan Little <stevan.little@iinteractive.com>
+
+Jesse Luehrs <doy@tozt.net>
=head1 COPYRIGHT AND LICENSE
View
124 lib/mop/attribute.pm
@@ -3,7 +3,7 @@ package mop::attribute;
use v5.16;
use warnings;
-use Scalar::Util qw[ weaken ];
+use Scalar::Util qw[ weaken isweak ];
our $VERSION = '0.01';
our $AUTHORITY = 'cpan:STEVAN';
@@ -24,19 +24,15 @@ sub new {
$name{ $self } = \($args{'name'});
$default{ $self } = \($args{'default'}) if exists $args{'default'};
$storage{ $self } = \($args{'storage'}) if exists $args{'storage'};
-
- $self
-}
-
-sub BUILD {
- my $self = shift;
# NOTE:
# keep track of the original ID here
# so that we can still detect attribute
# conflicts in roles even after something
# has been cloned
# - SL
- $original_id{ $self } //= \(mop::id($self));
+ $original_id{ $self } = \(mop::id($self));
+
+ $self
}
# temporary, for bootstrapping
@@ -45,7 +41,7 @@ sub clone {
return ref($self)->new(
name => $self->name,
default => ${ $default{ $self } },
- storage => $self->storage,
+ storage => ${ $storage{ $self } },
);
}
@@ -85,8 +81,6 @@ sub get_default {
$value
}
-sub storage { ${ $storage{ $_[0] } } }
-
sub associated_meta { ${ $associated_meta{ $_[0] } } }
sub set_associated_meta {
my ($self, $meta) = @_;
@@ -95,16 +89,17 @@ sub set_associated_meta {
}
sub conflicts_with { ${ $original_id{ $_[0] } } ne ${ $original_id{ $_[1] } } }
+sub locally_defined { ${ $original_id{ $_[0] } } eq mop::id( $_[0] ) }
sub has_data_in_slot_for {
my ($self, $instance) = @_;
- exists $self->storage->{ $instance };
+ defined ${ ${ $storage{ $self } }->{ $instance } };
}
sub fetch_data_in_slot_for {
my ($self, $instance) = @_;
$self->fire('before:FETCH_DATA', $instance);
- my $val = ${ $self->storage->{ $instance } || \undef };
+ my $val = ${ ${ $storage{ $self } }->{ $instance } || \undef };
$self->fire('after:FETCH_DATA', $instance);
return $val;
}
@@ -112,7 +107,7 @@ sub fetch_data_in_slot_for {
sub store_data_in_slot_for {
my ($self, $instance, $data) = @_;
$self->fire('before:STORE_DATA', $instance, \$data);
- $self->storage->{ $instance } = \$data;
+ ${ $storage{ $self } }->{ $instance } = \$data;
$self->fire('after:STORE_DATA', $instance, \$data);
return;
}
@@ -125,6 +120,21 @@ sub store_default_in_slot_for {
}) if $self->has_default;
}
+sub remove_data_in_slot_for {
+ my ($self, $instance) = @_;
+ delete ${ $storage{ $self } }->{ $instance };
+}
+
+sub weaken_data_in_slot_for {
+ my ($self, $instance) = @_;
+ weaken(${ ${ $storage{ $self } }->{ $instance } });
+}
+
+sub is_data_in_slot_weak_for {
+ my ($self, $instance) = @_;
+ isweak(${ ${ $storage{ $self } }->{ $instance } });
+}
+
our $METACLASS;
sub __INIT_METACLASS__ {
@@ -144,7 +154,8 @@ sub __INIT_METACLASS__ {
$METACLASS->add_attribute(mop::attribute->new(
name => '$!original_id',
- storage => \%original_id
+ storage => \%original_id,
+ default => \sub { mop::id($_) },
));
$METACLASS->add_attribute(mop::attribute->new(
@@ -163,20 +174,28 @@ sub __INIT_METACLASS__ {
storage => \%associated_meta
));
- $METACLASS->add_method( mop::method->new( name => 'BUILD', body => \&BUILD ) );
-
$METACLASS->add_method( mop::method->new( name => 'name', body => \&name ) );
$METACLASS->add_method( mop::method->new( name => 'key_name', body => \&key_name ) );
+
$METACLASS->add_method( mop::method->new( name => 'has_default', body => \&has_default ) );
$METACLASS->add_method( mop::method->new( name => 'get_default', body => \&get_default ) );
+ $METACLASS->add_method( mop::method->new( name => 'set_default', body => \&set_default ) );
+ $METACLASS->add_method( mop::method->new( name => 'clear_default', body => \&clear_default ) );
+
$METACLASS->add_method( mop::method->new( name => 'storage', body => \&storage ) );
+
$METACLASS->add_method( mop::method->new( name => 'associated_meta', body => \&associated_meta ) );
$METACLASS->add_method( mop::method->new( name => 'set_associated_meta', body => \&set_associated_meta ) );
$METACLASS->add_method( mop::method->new( name => 'conflicts_with', body => \&conflicts_with ) );
+ $METACLASS->add_method( mop::method->new( name => 'locally_defined', body => \&locally_defined ) );
+ $METACLASS->add_method( mop::method->new( name => 'has_data_in_slot_for', body => \&has_data_in_slot_for ) );
$METACLASS->add_method( mop::method->new( name => 'fetch_data_in_slot_for', body => \&fetch_data_in_slot_for ) );
$METACLASS->add_method( mop::method->new( name => 'store_data_in_slot_for', body => \&store_data_in_slot_for ) );
$METACLASS->add_method( mop::method->new( name => 'store_default_in_slot_for', body => \&store_default_in_slot_for ) );
+ $METACLASS->add_method( mop::method->new( name => 'remove_data_in_slot_for', body => \&remove_data_in_slot_for ) );
+ $METACLASS->add_method( mop::method->new( name => 'weaken_data_in_slot_for', body => \&weaken_default_in_slot_for ) );
+ $METACLASS->add_method( mop::method->new( name => 'is_data_in_slot_weak_for', body => \&is_data_in_slot_weak_for ) );
$METACLASS;
}
@@ -188,19 +207,77 @@ __END__
=head1 NAME
-mop::attribute
+mop::attribute - A meta-object to represent attributes
=head1 DESCRIPTION
+TODO
+
+=head1 METHODS
+
+=over 4
+
+=item C<BUILD>
+
+=item C<clone(%overrides)>
+
+=item C<name>
+
+=item C<key_name>
+
+=item C<has_default>
+
+=item C<get_default>
+
+=item C<set_default($default)>
+
+=item C<clear_default>
+
+=item C<storage>
+
+=item C<associated_meta>
+
+=item C<set_associated_meta($meta)>
+
+=item C<conflicts_with($obj)>
+
+=item C<locally_defined>
+
+=item C<has_data_in_slot_for($instance)>
+
+=item C<fetch_data_in_slot_for($instance)>
+
+=item C<store_data_in_slot_for($instance, $data)>
+
+=item C<store_default_in_slot_for($instance)>
+
+=item C<remove_data_in_slot_for($instance)>
+
+=item C<weaken_data_in_slot_for($instance)>
+
+=item C<is_data_in_slot_weak_for($instance)>
+
+=back
+
+=head1 SEE ALSO
+
+=head2 L<Attribute Details|mop::manual::details::attributes>
+
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
-exception. If you find a bug please either email me, or add the bug
-to cpan-RT.
+Since this module is still under development we would prefer to not
+use the RT bug queue and instead use the built in issue tracker on
+L<Github|http://www.github.com>.
+
+=head2 L<Git Repository|https://github.com/stevan/p5-mop-redux>
+
+=head2 L<Issue Tracker|https://github.com/stevan/p5-mop-redux/issues>
=head1 AUTHOR
-Stevan Little <stevan@iinteractive.com>
+Stevan Little <stevan.little@iinteractive.com>
+
+Jesse Luehrs <doy@tozt.net>
=head1 COPYRIGHT AND LICENSE
@@ -209,6 +286,9 @@ This software is copyright (c) 2013 by Infinity Interactive.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
+=for Pod::Coverage
+ new
+
=cut
View
49 lib/mop/class.pm
@@ -181,19 +181,55 @@ __END__
=head1 NAME
-mop::class
+mop::class - A meta-object to represent classes
=head1 DESCRIPTION
+TODO
+
+=head1 METHODS
+
+=over 4
+
+=item C<BUILD>
+
+=item C<superclass>
+
+=item C<is_abstract>
+
+=item C<make_class_abstract>
+
+=item C<new_instance(%args)>
+
+=item C<clone_instance($instance, %args)>
+
+=item C<instance_generator>
+
+=item C<set_instance_generator($generator)>
+
+=item C<create_fresh_instance_structure>
+
+=back
+
+=head1 SEE ALSO
+
+=head2 L<Class Details|mop::manual::details::classes>
+
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
-exception. If you find a bug please either email me, or add the bug
-to cpan-RT.
+Since this module is still under development we would prefer to not
+use the RT bug queue and instead use the built in issue tracker on
+L<Github|http://www.github.com>.
+
+=head2 L<Git Repository|https://github.com/stevan/p5-mop-redux>
+
+=head2 L<Issue Tracker|https://github.com/stevan/p5-mop-redux/issues>
=head1 AUTHOR
-Stevan Little <stevan@iinteractive.com>
+Stevan Little <stevan.little@iinteractive.com>
+
+Jesse Luehrs <doy@tozt.net>
=head1 COPYRIGHT AND LICENSE
@@ -202,6 +238,9 @@ This software is copyright (c) 2013 by Infinity Interactive.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
+=for Pod::Coverage
+ new
+
=cut
View
35 lib/mop/internals/observable.pm
@@ -40,6 +40,11 @@ sub fire {
return $self;
}
+sub has_events {
+ my $self = shift;
+ return $callbacks{ $self } && !!%{ ${ $callbacks{ $self } } };
+}
+
our $METACLASS;
sub __INIT_METACLASS__ {
@@ -59,6 +64,9 @@ sub __INIT_METACLASS__ {
$METACLASS->add_method( mop::method->new( name => 'bind', body => \&bind ) );
$METACLASS->add_method( mop::method->new( name => 'unbind', body => \&unbind ) );
$METACLASS->add_method( mop::method->new( name => 'fire', body => \&fire ) );
+
+ $METACLASS->add_method( mop::method->new( name => 'has_events', body => \&has_events ) );
+
$METACLASS;
}
@@ -70,19 +78,27 @@ __END__
=head1 NAME
-mop::method
+mop::internals::observable - internal use only
=head1 DESCRIPTION
+This is for internal use only, there is no public API here.
+
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
-exception. If you find a bug please either email me, or add the bug
-to cpan-RT.
+Since this module is still under development we would prefer to not
+use the RT bug queue and instead use the built in issue tracker on
+L<Github|http://www.github.com>.
+
+=head2 L<Git Repository|https://github.com/stevan/p5-mop-redux>
+
+=head2 L<Issue Tracker|https://github.com/stevan/p5-mop-redux/issues>
=head1 AUTHOR
-Stevan Little <stevan@iinteractive.com>
+Stevan Little <stevan.little@iinteractive.com>
+
+Jesse Luehrs <doy@tozt.net>
=head1 COPYRIGHT AND LICENSE
@@ -91,6 +107,15 @@ This software is copyright (c) 2013 by Infinity Interactive.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
+=begin Pod::Coverage
+
+ bind
+ unbind
+ fire
+ has_events
+
+=end Pod::Coverage
+
=cut
View
40 lib/mop/internals/syntax.pm
@@ -540,19 +540,27 @@ __END__
=head1 NAME
-mop::internal::syntax
+mop::internals::syntax - internal use only
=head1 DESCRIPTION
+This is for internal use only, there is no public API here.
+
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
-exception. If you find a bug please either email me, or add the bug
-to cpan-RT.
+Since this module is still under development we would prefer to not
+use the RT bug queue and instead use the built in issue tracker on
+L<Github|http://www.github.com>.
+
+=head2 L<Git Repository|https://github.com/stevan/p5-mop-redux>
+
+=head2 L<Issue Tracker|https://github.com/stevan/p5-mop-redux/issues>
=head1 AUTHOR
-Stevan Little <stevan@iinteractive.com>
+Stevan Little <stevan.little@iinteractive.com>
+
+Jesse Luehrs <doy@tozt.net>
=head1 COPYRIGHT AND LICENSE
@@ -561,6 +569,28 @@ This software is copyright (c) 2013 by Infinity Interactive.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
+=begin Pod::Coverage
+
+ class
+ role
+ namespace_parser
+ method
+ method_parser
+ has
+ has_parser
+ parse_modifier_with_single_value
+ parse_modifier_with_multiple_values
+ parse_traits
+ run_traits
+ parse_prototype
+ parse_name
+ stuff_value
+ parse_stuff_with_values
+ read_tokenish
+ syntax_error
+
+=end Pod::Coverage
+
=cut
View
79 lib/mop/internals/util.pm
@@ -52,6 +52,8 @@ sub install_meta {
sub apply_all_roles {
my ($to, @roles) = @_;
+ unapply_all_roles($to);
+
my $composite = create_composite_role(@roles);
$to->fire('before:CONSUME' => $composite);
@@ -93,6 +95,25 @@ sub apply_all_roles {
$to->fire('after:CONSUME' => $composite);
}
+sub unapply_all_roles {
+ my ($meta) = @_;
+
+ for my $attr ($meta->attributes) {
+ $meta->remove_attribute($attr->name)
+ unless $attr->locally_defined;
+ }
+
+ for my $method ($meta->methods) {
+ $meta->remove_method($method->name)
+ unless $method->locally_defined;
+ }
+
+ # XXX this is wrong, it will also remove required methods that were
+ # defined in the class directly
+ $meta->remove_required_method($_)
+ for $meta->required_methods;
+}
+
# this shouldn't be used, generally. the only case where this is necessary is
# when we have a class which doesn't use the mop inheriting from a class which
# does. in that case, we need to inflate a basic metaclass for that class in
@@ -227,6 +248,8 @@ sub find_common_base {
sub create_composite_role {
my (@roles) = @_;
+ @roles = map { ref($_) ? $_ : mop::meta($_) } @roles;
+
return $roles[0] if @roles == 1;
my $name = 'mop::role::COMPOSITE::OF::'
@@ -304,3 +327,59 @@ sub create_composite_role {
}
1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+mop::internals::util - internal use only
+
+=head1 DESCRIPTION
+
+This is for internal use only, there is no public API here.
+
+=head1 BUGS
+
+Since this module is still under development we would prefer to not
+use the RT bug queue and instead use the built in issue tracker on
+L<Github|http://www.github.com>.
+
+=head2 L<Git Repository|https://github.com/stevan/p5-mop-redux>
+
+=head2 L<Issue Tracker|https://github.com/stevan/p5-mop-redux/issues>
+
+=head1 AUTHOR
+
+Stevan Little <stevan.little@iinteractive.com>
+
+Jesse Luehrs <doy@tozt.net>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2013 by Infinity Interactive.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=begin Pod::Coverage
+
+ init_attribute_storage
+ register_object
+ is_nonmop_class
+ mark_nonmop_class
+ install_meta
+ apply_all_roles
+ unapply_all_roles
+ find_or_inflate_meta
+ inflate_meta
+ fix_metaclass_compatibility
+ rebase_metaclasses
+ find_common_base
+ create_composite_role
+ subname
+
+=end Pod::Coverage
+
+=cut
View
22 lib/mop/manual/details/attributes.pod
@@ -1,4 +1,4 @@
-# PODNAME: mop::manual::attributes
+package mop::manual::details::attributes;
# ABSTRACT: A manual for p5-mop
__END__
@@ -7,7 +7,11 @@ __END__
=head1 NAME
-mop::manual::attributes - A manual for p5-mop
+mop::manual::details::attributes - A manual for p5-mop
+
+=head1 DESCRIPTION
+
+TODO
=head1 GRAMMAR
@@ -25,7 +29,7 @@ that is followed by the name of the attribute metaclass
you wish to be used in constructing this attribute.
Which is optionally followed by the C<is> keyword that is
-followed by a comma seperated list of traits you wish to
+followed by a comma separated list of traits you wish to
be applied to your attribute.
Which is optionally followed by the assignment operator
@@ -33,10 +37,22 @@ Which is optionally followed by the assignment operator
An attribute definition must be terminated by a semicolon.
+=head1 BUGS
+
+Since this module is still under development we would prefer to not
+use the RT bug queue and instead use the built in issue tracker on
+L<Github|http://www.github.com>.
+
+=head2 L<Git Repository|https://github.com/stevan/p5-mop-redux>
+
+=head2 L<Issue Tracker|https://github.com/stevan/p5-mop-redux/issues>
+
=head1 AUTHOR
Stevan Little <stevan.little@iinteractive.com>
+Jesse Luehrs <doy@tozt.net>
+
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Infinity Interactive.
View
24 lib/mop/manual/details/classes.pod
@@ -1,4 +1,4 @@
-# PODNAME: mop::manual::classes
+package mop::manual::details::classes;
# ABSTRACT: A manual for p5-mop
__END__
@@ -7,7 +7,11 @@ __END__
=head1 NAME
-mop::manual::classes - A manual for p5-mop
+mop::manual::details::classes - A manual for p5-mop
+
+=head1 DESCRIPTION
+
+TODO
=head1 GRAMMAR
@@ -27,7 +31,7 @@ that is followed by the name of the class you wish to
subclass.
Which is optionally followed by the C<with> keyword that is
-followed by a comma seperated list of the names of the roles
+followed by a comma separated list of the names of the roles
you wish to be composed into your class.
Which is optionally followed by the C<meta> keyword
@@ -35,16 +39,28 @@ that is followed by the name of the metaclass you wish to
be used in constructing this class.
Which is optionally followed by the C<is> keyword that is
-followed by a comma seperated list of traits you wish to
+followed by a comma separated list of traits you wish to
be applied to your class.
After this comes a block, within which you can define
methods and attributes (refer to those docs for more info).
+=head1 BUGS
+
+Since this module is still under development we would prefer to not
+use the RT bug queue and instead use the built in issue tracker on
+L<Github|http://www.github.com>.
+
+=head2 L<Git Repository|https://github.com/stevan/p5-mop-redux>
+
+=head2 L<Issue Tracker|https://github.com/stevan/p5-mop-redux/issues>
+
=head1 AUTHOR
Stevan Little <stevan.little@iinteractive.com>
+Jesse Luehrs <doy@tozt.net>
+
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Infinity Interactive.
View
22 lib/mop/manual/details/methods.pod
@@ -1,4 +1,4 @@
-# PODNAME: mop::manual::methods
+package mop::manual::details::methods;
# ABSTRACT: A manual for p5-mop
__END__
@@ -7,7 +7,11 @@ __END__
=head1 NAME
-mop::manual::methods - A manual for p5-mop
+mop::manual::details::methods - A manual for p5-mop
+
+=head1 DESCRIPTION
+
+TODO
=head1 GRAMMAR
@@ -26,16 +30,28 @@ optionally followed by the assignment operator (C<=>) which
is then followed by a perl expression.
Which is optionally followed by the C<is> keyword that is
-followed by a comma seperated list of traits you wish to
+followed by a comma separated list of traits you wish to
be applied to your method.
After this comes a block, within which you can define
the body of the method.
+=head1 BUGS
+
+Since this module is still under development we would prefer to not
+use the RT bug queue and instead use the built in issue tracker on
+L<Github|http://www.github.com>.
+
+=head2 L<Git Repository|https://github.com/stevan/p5-mop-redux>
+
+=head2 L<Issue Tracker|https://github.com/stevan/p5-mop-redux/issues>
+
=head1 AUTHOR
Stevan Little <stevan.little@iinteractive.com>
+Jesse Luehrs <doy@tozt.net>
+
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Infinity Interactive.
View
190 lib/mop/manual/details/mop.pod
@@ -0,0 +1,190 @@
+package mop::manual::details::mop;
+# ABSTRACT: A manual for p5-mop
+
+__END__
+
+=pod
+
+=head1 NAME
+
+mop::manual::details::mop - A manual for p5-mop
+
+=head1 DESCRIPTION
+
+The following is an example of the core classes
+of the MOP written using the MOP itself.
+
+=head2 The MOP
+
+ class mop::object {
+ method new (%args) { ... }
+ method clone (%args) { ... }
+
+ method BUILDALL ($args) { ... }
+
+ method can ($name) { ... }
+ method isa ($class) { ... }
+ method does ($role) { ... }
+ method DOES ($name) { ... }
+
+ method DESTROY { ... }
+ }
+
+ class mop::attribute extends mop::object {
+ has $!name is ro;
+ has $!default;
+ has $!storage is ro = {};
+ has $!associated_meta is ro;
+ has $!original_id;
+
+ has $!callbacks;
+
+ method BUILD { ... }
+
+ method key_name { ... }
+
+ method has_default { ... }
+ method get_default { ... }
+ method clear_default { ... }
+ method set_default ($default) { ... }
+
+ method set_associated_meta ($meta) { ... }
+
+ method conflicts_with ($attr) { ... }
+ method locally_defined ($attr) { ... }
+
+ method fetch_data_in_slot_for ($instance) { ... }
+ method store_data_in_slot_for ($instance, $data) { ... }
+ method store_default_in_slot_for ($instance) { ... }
+ method remove_data_in_slot_for ($instance) { ... }
+ method weaken_data_in_slot_for ($instance) { ... }
+ method is_data_in_slot_weak_for ($instance) { ... }
+
+ method bind ($event_name, $cb) { ... }
+ method unbind ($event_name, $cb) { ... }
+ method fire ($event_name) { ... }
+ }
+
+ class mop::method extends mop::object {
+ has $!name is ro;
+ has $!body is ro;
+ has $!associated_meta is ro;
+ has $!original_id;
+
+ has $!callbacks;
+
+ method BUILD { ... }
+
+ method execute ($invocant, $args) { ... }
+
+ method set_associated_meta ($meta) { ... }
+
+ method conflicts_with ($attr) { ... }
+ method locally_defined ($attr) { ... }
+
+ method bind ($event_name, $cb) { ... }
+ method unbind ($event_name, $cb) { ... }
+ method fire ($event_name) { ... }
+ }
+
+ class mop::role extends mop::object {
+ has $!name is ro;
+ has $!version is ro;
+ has $!authority is ro;
+
+ has $!roles is ro = [];
+ has $!attributes = {};
+ has $!methods = {};
+ has $!required_methods = {};
+
+ has $!callbacks;
+
+ method BUILD { ... }
+
+ method add_role ($role) { ... }
+ method does_role ($name) { ... }
+
+ method attribute_class { 'mop::attribute' }
+
+ method attributes { ... }
+ method attribute_map { ... }
+
+ method add_attribute ($attr) { ... }
+ method get_attribute ($name) { ... }
+ method has_attribute ($name) { ... }
+
+ method method_class { 'mop::method' }
+
+ method methods { ... }
+ method method_map { ... }
+
+ method add_method ($attr) { ... }
+ method get_method ($name) { ... }
+ method has_method ($name) { ... }
+
+ method required_methods { ... }
+ method required_method_map { ... }
+
+ method add_required_method ($required_method) { ... }
+ method remove_required_method ($required_method) { ... }
+ method requires_method ($name) { ... }
+
+ method bind ($event_name, $cb) { ... }
+ method unbind ($event_name, $cb) { ... }
+ method fire ($event_name) { ... }
+
+ sub FINALIZE { ... }
+ }
+
+ # 'with mop::role' is odd because mop::role is a class, but it works as
+ # you would expect
+ class mop::class extends mop::object with mop::role {
+ has $!superclass is ro;
+ has $!is_abstract is ro;
+ has $!instance_generator is ro = sub { \(my $anon) };
+
+ method BUILD { ... }
+
+ method make_class_abstract { ... }
+
+ method new_instance { ... }
+ method clone_instance { ... }
+
+ method set_instance_generator ($generator) { ... }
+ method create_fresh_instance_structure { ... }
+ }
+
+=head2 BOOTSTRAPPING GOALS
+
+ Class is an instance of Class
+ Object is an instance of Class
+ Class is a subclass of Object
+
+ Class does Role
+ Role is an instance of Class
+ Role does Role
+
+=head1 BUGS
+
+Since this module is still under development we would prefer to not
+use the RT bug queue and instead use the built in issue tracker on
+L<Github|http://www.github.com>.
+
+=head2 L<Git Repository|https://github.com/stevan/p5-mop-redux>
+
+=head2 L<Issue Tracker|https://github.com/stevan/p5-mop-redux/issues>
+
+=head1 AUTHOR
+
+Stevan Little <stevan.little@iinteractive.com>
+
+Jesse Luehrs <doy@tozt.net>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2013 by Infinity Interactive.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
View
24 lib/mop/manual/details/roles.pod
@@ -1,4 +1,4 @@
-# PODNAME: mop::manual::roles
+package mop::manual::details::roles;
# ABSTRACT: A manual for p5-mop
__END__
@@ -7,7 +7,11 @@ __END__
=head1 NAME
-mop::manual::roles - A manual for p5-mop
+mop::manual::details::roles - A manual for p5-mop
+
+=head1 DESCRIPTION
+
+TODO
=head1 GRAMMAR
@@ -22,7 +26,7 @@ Roles in the p5-mop are defined in the following way:
The C<role> keyword is followed by a name.
Which is optionally followed by the C<with> keyword that is
-followed by a comma seperated list of the names of the roles
+followed by a comma separated list of the names of the roles
you wish to be composed into your role.
Which is optionally followed by the C<meta> keyword
@@ -30,16 +34,28 @@ that is followed by the name of the metarole you wish to
be used in constructing this role.
Which is optionally followed by the C<is> keyword that is
-followed by a comma seperated list of traits you wish to
+followed by a comma separated list of traits you wish to
be applied to your role.
After this comes a block, within which you can define
methods and attributes (refer to those docs for more info).
+=head1 BUGS
+
+Since this module is still under development we would prefer to not
+use the RT bug queue and instead use the built in issue tracker on
+L<Github|http://www.github.com>.
+
+=head2 L<Git Repository|https://github.com/stevan/p5-mop-redux>
+
+=head2 L<Issue Tracker|https://github.com/stevan/p5-mop-redux/issues>
+
=head1 AUTHOR
Stevan Little <stevan.little@iinteractive.com>
+Jesse Luehrs <doy@tozt.net>
+
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Infinity Interactive.