view lib/IMPL/Class/ClassInfo.pm @ 427:09e0086a82a7 ref20150831 tip

Merge
author cin
date Tue, 15 May 2018 00:51:33 +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;