diff lib/IMPL/Class/ClassInfo.pm @ 423:60c2892a577c ref20150831

working on base class system
author cin
date Mon, 02 Apr 2018 07:35:23 +0300
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Class/ClassInfo.pm	Mon Apr 02 07:35:23 2018 +0300
@@ -0,0 +1,73 @@
+package IMPL::Class::ClassInfo;
+use strict;
+
+use Sub::Util qw(subname);
+use mro;
+
+my %props;
+
+sub new {
+	my ( $self, $class ) = @_;
+
+	return bless \$class, $self;
+}
+
+sub className {
+	${ $_[0] };
+}
+
+sub linearISA {
+	return mro::get_linear_isa( ${ $_[0] } );
+}
+
+sub members {
+
+}
+
+sub methods {
+	my ( $this, %opts ) = @_;
+
+	my %hide;
+
+	if ( !$opts{hidden} ) {
+		%hide =
+		  map ( ( $_, 1 ), map @{$_}{qw(getter setter)},
+			$this->properties(%opts) );
+	}
+
+	if ( !$opts{inherited} ) {
+		no strict 'refs';
+		my $class = $this->className();
+
+		my @members;
+
+		while ( my ( $k, $v ) = each %{"${class}::"} ) {
+			my $fn = *{$v}{CODE};
+			next unless $fn;
+
+			my ( $fqname, $pkg, $name ) =
+			  ( subname($fn) =~ m/^((.+)::(.+?))$/ );
+
+			push @members, $fqname if $pkg eq $class and not $hide{$name};
+		}
+
+		return @members;
+	}
+	else {
+
+		my @isa =
+		  reverse( $opts{inherited} ? $this->linearISA() : $this->className() );
+
+		my %methods = map { $_->memberName(), $_ }
+		  grep not( $hide{ $_->memberName() } ),
+		  map { IMPL::Class::ClassInfo->new($_)->methods( inherited => 0 ) } @isa;
+
+		return values %methods;
+	}
+}
+
+sub properties {
+
+}
+
+1;