File Coverage

blib/lib/Devel/REPL/Plugin/ShowClass.pm
Criterion Covered Total %
statement 12 38 31.5
branch 0 20 0.0
condition 0 3 0.0
subroutine 4 6 66.6
pod 0 2 0.0
total 16 69 23.1


line stmt bran cond sub pod time code
1 2     2   3148 use strict;
  2         4  
  2         91  
2 2     2   13 use warnings;
  2         6  
  2         167  
3             package Devel::REPL::Plugin::ShowClass;
4             # ABSTRACT: Dump classes initialized with Class::MOP
5              
6             our $VERSION = '1.003027';
7              
8 2     2   13 use Devel::REPL::Plugin;
  2         4  
  2         19  
9 2     2   11590 use namespace::autoclean;
  2         5  
  2         25  
10              
11             has 'metaclass_cache' => (
12             is => 'ro',
13             isa => 'HashRef',
14             lazy => 1,
15             default => sub {{}}
16             );
17              
18             before 'eval' => sub {
19             my $self = shift;
20             $self->update_metaclass_cache;
21             };
22              
23             after 'eval' => sub {
24             my $self = shift;
25              
26             my @metas_to_show;
27              
28             foreach my $class (Class::MOP::get_all_metaclass_names()) {
29             unless (exists $self->metaclass_cache->{$class}) {
30             push @metas_to_show => Class::MOP::get_metaclass_by_name($class)
31             }
32             }
33              
34             $self->display_class($_) foreach @metas_to_show;
35              
36             $self->update_metaclass_cache;
37             };
38              
39             sub update_metaclass_cache {
40 0     0 0   my $self = shift;
41 0           foreach my $class (Class::MOP::get_all_metaclass_names()) {
42 0           $self->metaclass_cache->{$class} = (
43             ("" . Class::MOP::get_metaclass_by_name($class))
44             );
45             }
46             }
47              
48             sub display_class {
49 0     0 0   my ($self, $meta) = @_;
50 0           $self->print('package ' . $meta->name . ";\n\n");
51 0 0         $self->print('extends (' . (join ", " => $meta->superclasses) . ");\n\n") if $meta->superclasses;
52 0 0         $self->print('with (' . (join ", " => map { $_->name } @{$meta->roles}) . ");\n\n") if $meta->can('roles');
  0            
  0            
53 0           foreach my $attr (map { $meta->get_attribute($_) } $meta->get_attribute_list) {
  0            
54 0           $self->print('has ' . $attr->name . " => (\n");
55 0 0         $self->print(' is => ' . $attr->_is_metadata . ",\n") if $attr->_is_metadata;
56 0 0         $self->print(' isa => ' . $attr->_isa_metadata . ",\n") if $attr->_isa_metadata;
57 0 0         $self->print(' required => ' . $attr->is_required . ",\n") if $attr->is_required;
58 0 0         $self->print(' lazy => ' . $attr->is_lazy . ",\n") if $attr->is_lazy;
59 0 0         $self->print(' coerce => ' . $attr->should_coerce . ",\n") if $attr->should_coerce;
60 0 0         $self->print(' is_weak_ref => ' . $attr->is_weak_ref . ",\n") if $attr->is_weak_ref;
61 0 0         $self->print(' auto_deref => ' . $attr->should_auto_deref . ",\n") if $attr->should_auto_deref;
62 0           $self->print(");\n");
63 0           $self->print("\n");
64             }
65 0           foreach my $method_name ($meta->get_method_list) {
66 0 0 0       next if $method_name eq 'meta'
67             || $meta->get_method($method_name)->isa('Class::MOP::Method::Accessor');
68 0           $self->print("sub $method_name { ... }\n");
69 0           $self->print("\n");
70             }
71 0           $self->print("1;\n");
72             }
73              
74             1;
75              
76             __END__
77              
78             =pod
79              
80             =encoding UTF-8
81              
82             =head1 NAME
83              
84             Devel::REPL::Plugin::ShowClass - Dump classes initialized with Class::MOP
85              
86             =head1 VERSION
87              
88             version 1.003027
89              
90             =head1 AUTHOR
91              
92             Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>)
93              
94             =head1 COPYRIGHT AND LICENSE
95              
96             This software is copyright (c) 2007 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>).
97              
98             This is free software; you can redistribute it and/or modify it under
99             the same terms as the Perl 5 programming language system itself.
100              
101             =cut