1 package MooseX::AutoDoc;
7 use Moose::Meta::Class;
8 use Scalar::Util qw/blessed/;
10 # Create a special TypeConstraint for the View so you can just set it
11 # with a class name and it'll DWIM
13 use Moose::Util::TypeConstraints;
17 => where { $_->isa('MooseX::AutoDoc::View') }
18 => message { "Value should be a subclass of MooseX::AutoDoc::View" } ;
22 => via { Class::MOP::load_class($_); $_->new };
24 no Moose::Util::TypeConstraints;
28 has view => (is => 'rw', isa => 'AutoDocView', coerce => 1, lazy_build => 1);
30 #type constraint library to name mapping to make nice links
31 has tc_to_lib_map => (is => 'rw', isa => 'HashRef', lazy_build => 1);
33 #method metaclasses to ignore to avoid documenting some methods
34 has ignored_method_metaclasses => (is => 'rw', isa => 'HashRef', lazy_build => 1);
36 #defaults to artistic...
37 has license_text => (is => 'rw', isa => 'Str', lazy_build => 1);
39 #how can i get the data about the current user?
40 has authors => (is => 'rw', isa => 'ArrayRef[HashRef]',
41 predicate => 'has_authors');
43 sub _build_view { "MooseX::AutoDoc::View::TT" }
45 sub _build_tc_to_lib_map {
46 my %types = map {$_ => 'Moose::Util::TypeConstraints'}
47 qw/Any Item Bool Undef Defined Value Num Int Str Role Maybe ClassName Ref
48 ScalarRef ArrayRef HashRef CodeRef RegexpRef GlobRef FileHandle Object/;
52 sub _build_ignored_method_metaclasses {
54 'Moose::Meta::Role::Method' => 1,
55 'Moose::Meta::Method::Accessor' => 1,
56 'Moose::Meta::Method::Constructor' => 1,
57 'Class::MOP::Method::Accessor' => 1,
58 'Class::MOP::Method::Generated' => 1,
59 'Class::MOP::Method::Constructor' => 1,
62 # 'Moose::Meta::Method::Overridden' => 1,
63 # 'Class::MOP::Method::Wrapped' => 1,
66 sub _build_license_text {
67 "This library is free software; you can redistribute it and/or modify it "
68 ."under the same terms as Perl itself.";
72 sub generate_pod_for_role {
73 my ($self, $role, $view_args) = @_;
75 carp("${role} is already loaded. This will cause inacurate output.".
76 "if ${role} is the consumer of any roles.")
77 if Class::MOP::is_class_loaded( $role );
79 my $spec = $self->role_info($role);
82 license => $self->license_text,
83 authors => $self->has_authors ? $self->authors : [],
85 return $self->view->render_role($vars, $view_args);
89 sub generate_pod_for_class {
90 my ($self, $class, $view_args) = @_;
92 carp("${class} is already loaded. This will cause inacurate output.".
93 "if ${class} is the consumer of any roles.")
94 if Class::MOP::is_class_loaded( $class );
96 my $spec = $self->class_info($class);
99 license => $self->license_text,
100 authors => $self->has_authors ? $self->authors : [],
103 return $self->view->render_class($vars, $view_args);
109 my ($self, $role) = @_;
111 my (@roles_to_apply, $rmeta, $original_apply);
112 { #intercept role application so we can accurately generate
113 #method and attribute information for the parent class.
114 #this is fragile, but there is not better way that i am aware of
116 $rmeta = Moose::Meta::Role->meta;
117 $rmeta->make_mutable if $rmeta->is_immutable;
118 $original_apply = $rmeta->get_method("apply")->body;
119 $rmeta->remove_method("apply");
120 $rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])});
122 eval { Class::MOP::load_class($role); };
123 confess "Failed to load class ${role} $@" if $@;
126 my $meta = $role->meta;
127 my $anon = Moose::Meta::Class->create_anon_class;
128 $original_apply->($meta, $anon);
130 my @attributes = map{ $anon->get_attribute($_) } sort $anon->get_attribute_list;
132 my %ignored_method_metaclasses = %{ $self->ignored_method_metaclasses };
133 delete $ignored_method_metaclasses{'Moose::Meta::Role::Method'};
135 grep{ ! exists $ignored_method_metaclasses{$_->meta->name} }
136 map { $anon->get_method($_) }
137 grep { $_ ne 'meta' } #it wasnt getting filtered on the anon class..
138 sort $anon->get_method_list;
139 my @method_specs = map{ $self->method_info($_) } @methods;
140 my @attribute_specs = map{ $self->attribute_info($_) } @attributes;
142 { #fix Moose::Meta::Role and apply the roles that were delayed
143 $rmeta->remove_method("apply");
144 $rmeta->add_method("apply", $original_apply);
145 $rmeta->make_immutable;
146 shift(@$_)->apply(@$_) for @roles_to_apply;
150 sort{ $a->name cmp $b->name }
151 map { $_->isa("Moose::Meta::Role::Composite") ? @{$_->get_roles} : $_ }
152 @{ $meta->get_roles };
154 my @role_specs = map{ $self->consumed_role_info($_) } @roles;
158 roles => \ @role_specs,
159 methods => \ @method_specs,
160 attributes => \ @attribute_specs,
168 my ($self, $class) = @_;
170 my (@roles_to_apply, $rmeta, $original_apply);
171 { #intercept role application so we can accurately generate
172 #method and attribute information for the parent class.
173 #this is fragile, but there is not better way that i am aware of
175 $rmeta = Moose::Meta::Role->meta;
176 $rmeta->make_mutable if $rmeta->is_immutable;
177 $original_apply = $rmeta->get_method("apply")->body;
178 $rmeta->remove_method("apply");
179 $rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])});
181 eval { Class::MOP::load_class($class); };
182 confess "Failed to load class ${class} $@" if $@;
185 my $meta = $class->meta;
187 my @attributes = map{ $meta->get_attribute($_) } sort $meta->get_attribute_list;
188 my @superclasses = map{ $_->meta }
189 grep { $_ ne 'Moose::Object' } $meta->superclasses;
192 grep{ ! exists $self->ignored_method_metaclasses->{$_->meta->name} }
193 map { $meta->get_method($_) }
194 grep { $_ ne 'meta' } #it wasnt getting filtered on the anon class..
195 sort $meta->get_method_list;
197 my @method_specs = map{ $self->method_info($_) } @methods;
198 my @attribute_specs = map{ $self->attribute_info($_) } @attributes;
199 my @superclass_specs = map{ $self->superclass_info($_) } @superclasses;
201 { #fix Moose::Meta::Role and apply the roles that were delayed
202 $rmeta->remove_method("apply");
203 $rmeta->add_method("apply", $original_apply);
204 $rmeta->make_immutable;
205 shift(@$_)->apply(@$_) for @roles_to_apply;
208 my @roles = sort{ $a->name cmp $b->name }
209 map { $_->isa("Moose::Meta::Role::Composite") ? @{$_->get_roles} : $_ }
211 my @role_specs = map{ $self->consumed_role_info($_) } @roles;
215 roles => \ @role_specs,
216 methods => \ @method_specs,
217 attributes => \ @attribute_specs,
218 superclasses => \ @superclass_specs,
225 my($self, $attr) = @_;;
226 my $attr_name = $attr->name;
227 my $spec = { name => $attr_name };
228 my $info = $spec->{info} = {};
230 $info->{clearer} = $attr->clearer if $attr->has_clearer;
231 $info->{builder} = $attr->builder if $attr->has_builder;
232 $info->{predicate} = $attr->predicate if $attr->has_predicate;
235 my $description = $attr->is_required ? 'Required ' : 'Optional ';
236 if( defined(my $is = $attr->_is_metadata) ){
237 $description .= 'read-only ' if $is eq 'ro';
238 $description .= 'read-write ' if $is eq 'rw';
240 #If we have 'is' info only write out this info if it != attr_name
241 $info->{writer} = $attr->writer
242 if $attr->has_writer && $attr->writer ne $attr_name;
243 $info->{reader} = $attr->reader
244 if $attr->has_reader && $attr->reader ne $attr_name;
245 $info->{accessor} = $attr->accessor
246 if $attr->has_accessor && $attr->accessor ne $attr_name;
248 $info->{writer} = $attr->writer if $attr->has_writer;
249 $info->{reader} = $attr->reader if $attr->has_reader;
250 $info->{accessor} = $attr->accessor if $attr->has_accessor;
253 if( defined(my $lazy = $attr->is_lazy) ){
254 $description .= 'lazy-building ';
256 $description .= 'value';
257 if( defined(my $isa = $attr->_isa_metadata) ){
261 while( blessed $isa ){
264 my @parts = split '::', $isa;
265 my $type_name = pop @parts;
266 my $type_lib = join "::", @parts;
267 if(eval{$type_lib->isa("MooseX::Types::Base")}){
268 $link_to = $type_lib;
272 my ($isa_base) = ($isa =~ /^(.*?)(?:\[.*\])?$/);
273 if (exists $self->tc_to_lib_map->{$isa_base}){
274 $link_to = $self->tc_to_lib_map->{$isa_base};
278 if(defined $link_to){
279 $isa = "L<${isa}|${link_to}>";
281 $description .= " of type ${isa}";
283 if( $attr->should_auto_deref){
284 $description .=" that will be automatically dereferenced by ".
285 "the reader / accessor";
287 if( $attr->has_documentation ){
288 $description .= "\n\n" . $attr->documentation;
290 $spec->{description} = $description;
295 sub superclass_info {
296 my($self, $superclass) = @_;
297 my $spec = { name => $superclass->name };
302 my($self, $method) = @_;
303 my $spec = { name => $method->name };
307 sub consumed_role_info {
308 my($self, $role) = @_;;
309 my $spec = { name => $role->name };