Commit | Line | Data |
e958cbc6 |
1 | package Devel::REPL::Plugin::ShowClass; |
2 | use Moose::Role; |
3 | |
4 | has 'metaclass_cache' => ( |
5 | is => 'ro', |
6 | isa => 'HashRef', |
7 | lazy => 1, |
8 | default => sub {{}} |
9 | ); |
10 | |
11 | before 'eval' => sub { |
12 | my $self = shift; |
13 | $self->update_metaclass_cache; |
14 | }; |
15 | |
16 | after 'eval' => sub { |
17 | my $self = shift; |
18 | |
19 | my @metas_to_show; |
20 | |
21 | foreach my $class (Class::MOP::get_all_metaclass_names()) { |
22 | unless (exists $self->metaclass_cache->{$class}) { |
23 | push @metas_to_show => Class::MOP::get_metaclass_by_name($class) |
24 | } |
25 | } |
26 | |
27 | $self->display_class($_) foreach @metas_to_show; |
28 | |
29 | $self->update_metaclass_cache; |
30 | }; |
31 | |
32 | sub update_metaclass_cache { |
33 | my $self = shift; |
34 | foreach my $class (Class::MOP::get_all_metaclass_names()) { |
35 | $self->metaclass_cache->{$class} = ( |
36 | ("" . Class::MOP::get_metaclass_by_name($class)) |
37 | ); |
38 | } |
39 | } |
40 | |
41 | sub display_class { |
42 | my ($self, $meta) = @_; |
43 | $self->print('package ' . $meta->name . ";\n\n"); |
44 | $self->print('extends (' . (join ", " => $meta->superclasses) . ");\n\n") if $meta->superclasses; |
45 | $self->print('with (' . (join ", " => map { $_->name } @{$meta->roles}) . ");\n\n") if $meta->can('roles'); |
46 | foreach my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) { |
47 | $self->print('has ' . $attr->name . " => (\n"); |
48 | $self->print(' is => ' . $attr->_is_metadata . ",\n") if $attr->_is_metadata; |
49 | $self->print(' isa => ' . $attr->_isa_metadata . ",\n") if $attr->_isa_metadata; |
50 | $self->print(' required => ' . $attr->is_required . ",\n") if $attr->is_required; |
51 | $self->print(' lazy => ' . $attr->is_lazy . ",\n") if $attr->is_lazy; |
52 | $self->print(' coerce => ' . $attr->should_coerce . ",\n") if $attr->should_coerce; |
53 | $self->print(' is_weak_ref => ' . $attr->is_weak_ref . ",\n") if $attr->is_weak_ref; |
54 | $self->print(' auto_deref => ' . $attr->should_auto_deref . ",\n") if $attr->should_auto_deref; |
55 | $self->print(");\n"); |
56 | $self->print("\n"); |
57 | } |
58 | foreach my $method_name ($meta->get_method_list) { |
59 | next if $method_name eq 'meta' |
60 | || $meta->get_method($method_name)->isa('Class::MOP::Method::Accessor'); |
61 | $self->print("sub $method_name { ... }\n"); |
62 | $self->print("\n"); |
63 | } |
64 | $self->print("1;\n"); |
65 | } |
66 | |
67 | 1; |
68 | |