Mercurial > pub > Impl
view lib/IMPL/Class/ClassInfo.pm @ 424:87af445663d7 ref20150831
IMPL::Object::_Base
author | cin |
---|---|
date | Tue, 03 Apr 2018 10:54:09 +0300 |
parents | 60c2892a577c |
children |
line wrap: on
line source
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;