Mercurial > pub > Impl

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
working on base class system
author cin
date Mon, 02 Apr 2018 07:35:23 +0300
parents
children
comparison
equal deleted inserted replaced
422:b0481c071bea 423:60c2892a577c
1 package IMPL::Class::ClassInfo;
2 use strict;
3
4 use Sub::Util qw(subname);
5 use mro;
6
7 my %props;
8
9 sub new {
10 my ( $self, $class ) = @_;
11
12 return bless \$class, $self;
13 }
14
15 sub className {
16 ${ $_[0] };
17 }
18
19 sub linearISA {
20 return mro::get_linear_isa( ${ $_[0] } );
21 }
22
23 sub members {
24
25 }
26
27 sub methods {
28 my ( $this, %opts ) = @_;
29
30 my %hide;
31
32 if ( !$opts{hidden} ) {
33 %hide =
34 map ( ( $_, 1 ), map @{$_}{qw(getter setter)},
35 $this->properties(%opts) );
36 }
37
38 if ( !$opts{inherited} ) {
39 no strict 'refs';
40 my $class = $this->className();
41
42 my @members;
43
44 while ( my ( $k, $v ) = each %{"${class}::"} ) {
45 my $fn = *{$v}{CODE};
46 next unless $fn;
47
48 my ( $fqname, $pkg, $name ) =
49 ( subname($fn) =~ m/^((.+)::(.+?))$/ );
50
51 push @members, $fqname if $pkg eq $class and not $hide{$name};
52 }
53
54 return @members;
55 }
56 else {
57
58 my @isa =
59 reverse( $opts{inherited} ? $this->linearISA() : $this->className() );
60
61 my %methods = map { $_->memberName(), $_ }
62 grep not( $hide{ $_->memberName() } ),
63 map { IMPL::Class::ClassInfo->new($_)->methods( inherited => 0 ) } @isa;
64
65 return values %methods;
66 }
67 }
68
69 sub properties {
70
71 }
72
73 1;