initial, pretty broken code

2 files changed, 92 insertions, 0 deletions

diff --git a/lib/Class/Info.pm b/lib/Class/Info.pm
new file mode 100644
index 0000000..461a07b
--- /dev/null
+++ b/lib/Class/Info.pm
@@ -0,0 +1,70 @@
+package Class::Info;
+use Moose;
+use Moose::Util::TypeConstraints;
+use Class::Info::Method;
+
+subtype 'Meta',
+    as 'Class::MOP::Class';
+coerce 'Meta',
+    from 'Str',
+    via { Class::MOP::load_class(@_); Class::MOP::Class->initialize($_) };
+
+has metaclass => (
+    is       => 'ro',
+    isa      => 'Meta',
+    required => 1,
+    init_arg => 'class',
+    coerce   => 1,
+    handles  => {
+        name      => 'name',
+        does_role => 'does_role',
+    },
+);
+
+has methods => (
+    is       => 'ro',
+    isa      => 'ArrayRef[Class::Info::Method]',
+    auto_deref => 1,
+    lazy     => 1,
+    default  => sub {[
+        map { Class::Info::Method->new($_) } shift->metaclass->get_all_methods
+    ]},
+);
+
+sub BUILDARGS {
+    my $class = shift;
+    return { class => $_[0] } if @_ == 1;
+    return $class->SUPER::BUILDARGS(@_);
+}
+
+sub classify_methods {
+    my $self = shift;
+    my @methods = $self->methods;
+    my @local_methods = ();
+    my %role_methods = ();
+    my %superclass_methods = ();
+    my %imports = ();
+    for my $method (@methods) {
+        my $origin = $method->package_name;
+        if ($self->name eq $origin) {
+            push @local_methods, $method;
+        }
+        elsif ($self->name->isa($origin)) {
+            push @{ $superclass_methods{$origin} ||= [] }, $method;
+        }
+        elsif ($self->does_role($origin)) {
+            push @{ $role_methods{$origin} ||= [] }, $method;
+        }
+        else {
+            push @{ $imports{$origin} ||= [] }, $method;
+        }
+    }
+    return {
+        local     => \@local_methods,
+        composed  => \%role_methods,
+        inherited => \%superclass_methods,
+        imported  => \%imports,
+    };
+}
+
+1;
diff --git a/lib/Class/Info/Method.pm b/lib/Class/Info/Method.pm
new file mode 100644
index 0000000..43742c0
--- /dev/null
+++ b/lib/Class/Info/Method.pm
@@ -0,0 +1,22 @@
+package Class::Info::Method;
+use Moose;
+
+has method => (
+    is       => 'ro',
+    isa      => 'Class::MOP::Method',
+    required => 1,
+    handles  => qr/.*/,
+);
+
+sub BUILDARGS {
+    my $class = shift;
+    return { method => $_[0] } if @_ == 1;
+    return $class->SUPER::BUILDARGS(@_);
+}
+
+sub as_string {
+    my $self = shift;
+    return $self->name . " (" . blessed($self->method) . ")";
+}
+
+1;