Mercurial > pub > Impl
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;