Commit | Line | Data |
3890b670 |
1 | package MooseX::AutoDoc; |
2 | |
3 | use Moose; |
4 | use Carp; |
5 | use Class::MOP; |
6 | use Moose::Meta::Role; |
7 | use Moose::Meta::Class; |
8 | use Scalar::Util qw/blessed/; |
9 | |
10 | # Create a special TypeConstraint for the View so you can just set it |
11 | # with a class name and it'll DWIM |
12 | { |
13 | use Moose::Util::TypeConstraints; |
14 | |
15 | subtype 'AutoDocView' |
16 | => as 'Object' |
17 | => where { $_->isa('MooseX::AutoDoc::View') } |
18 | => message { "Value should be a subclass of MooseX::AutoDoc::View" } ; |
19 | |
20 | coerce 'AutoDocView' |
21 | => from 'Str' |
22 | => via { Class::MOP::load_class($_); $_->new }; |
23 | |
24 | no Moose::Util::TypeConstraints; |
25 | } |
26 | |
27 | #view object |
28 | has view => (is => 'rw', isa => 'AutoDocView', coerce => 1, lazy_build => 1); |
29 | |
30 | #type constraint library to name mapping to make nice links |
31 | has tc_to_lib_map => (is => 'rw', isa => 'HashRef', lazy_build => 1); |
32 | |
33 | #method metaclasses to ignore to avoid documenting some methods |
34 | has ignored_method_metaclasses => (is => 'rw', isa => 'HashRef', lazy_build => 1); |
35 | |
36 | #defaults to artistic... |
37 | has license_text => (is => 'rw', isa => 'Str', lazy_build => 1); |
38 | |
39 | #how can i get the data about the current user? |
40 | has authors => (is => 'rw', isa => 'ArrayRef[HashRef]', |
41 | predicate => 'has_authors'); |
42 | |
43 | sub _build_view { "MooseX::AutoDoc::View::TT" } |
44 | |
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/; |
49 | return \ %types; |
50 | } |
51 | |
52 | sub _build_ignored_method_metaclasses { |
53 | return { |
3890b670 |
54 | 'Moose::Meta::Method::Accessor' => 1, |
55 | 'Moose::Meta::Method::Constructor' => 1, |
56 | 'Class::MOP::Method::Accessor' => 1, |
57 | 'Class::MOP::Method::Generated' => 1, |
58 | 'Class::MOP::Method::Constructor' => 1, |
59 | }; |
60 | |
ec75fdb0 |
61 | # 'Moose::Meta::Role::Method' => 1, |
3890b670 |
62 | # 'Moose::Meta::Method::Overridden' => 1, |
63 | # 'Class::MOP::Method::Wrapped' => 1, |
ec75fdb0 |
64 | |
3890b670 |
65 | } |
66 | |
67 | sub _build_license_text { |
68 | "This library is free software; you can redistribute it and/or modify it " |
69 | ."under the same terms as Perl itself."; |
70 | } |
71 | |
72 | #make the actual POD |
a3e8bacb |
73 | sub generate_pod_for { |
74 | my ($self, $package, $view_args) = @_; |
3890b670 |
75 | |
a3e8bacb |
76 | carp("${package} is already loaded. This will cause inacurate output.". |
77 | "if ${package} is the consumer of any roles.") |
78 | if Class::MOP::is_class_loaded( $package ); |
3890b670 |
79 | |
10873f5d |
80 | my $spec = $self->_package_info($package); |
a3e8bacb |
81 | my $key = $package->meta->isa("Moose::Meta::Role") ? 'role' : 'class'; |
3890b670 |
82 | my $vars = { |
a3e8bacb |
83 | $key => $spec, |
3890b670 |
84 | license => $self->license_text, |
85 | authors => $self->has_authors ? $self->authors : [], |
86 | }; |
a3e8bacb |
87 | my $render = "render_${key}"; |
88 | return $self->view->$render($vars, $view_args); |
3890b670 |
89 | } |
90 | |
3890b670 |
91 | # *_info methods |
a3e8bacb |
92 | sub _package_info { |
93 | my($self, $package) = @_; |
94 | |
95 | #intercept role application so we can accurately generate |
96 | #method and attribute information for the parent class. |
97 | #this is fragile, but there is not better way that i am aware of |
98 | my $rmeta = Moose::Meta::Role->meta; |
99 | $rmeta->make_mutable if $rmeta->is_immutable; |
100 | my $original_apply = $rmeta->get_method("apply")->body; |
101 | $rmeta->remove_method("apply"); |
102 | my @roles_to_apply; |
103 | $rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])}); |
104 | #load the package with the hacked Moose::Meta::Role |
105 | eval { Class::MOP::load_class($package); }; |
106 | confess "Failed to load package ${package} $@" if $@; |
107 | |
108 | #get on with analyzing the package |
109 | my $meta = $package->meta; |
110 | my $spec = {}; |
111 | my ($class, $is_role); |
112 | if($package->meta->isa('Moose::Meta::Role')){ |
113 | $is_role = 1; |
114 | # we need to apply the role to a class to be able to properly introspect it |
115 | $class = Moose::Meta::Class->create_anon_class; |
116 | $original_apply->($meta, $class); |
117 | } else { |
118 | #roles don't have superclasses ... |
119 | $class = $meta; |
120 | my @superclasses = map{ $_->meta } |
121 | grep { $_ ne 'Moose::Object' } $meta->superclasses; |
122 | my @superclass_specs = map{ $self->_superclass_info($_) } @superclasses; |
123 | $spec->{superclasses} = \@superclass_specs; |
3890b670 |
124 | } |
125 | |
a3e8bacb |
126 | #these two are common to both roles and classes |
127 | my @attributes = map{ $class->get_attribute($_) } sort $class->get_attribute_list; |
128 | my @methods = |
3890b670 |
129 | grep{ ! exists $self->ignored_method_metaclasses->{$_->meta->name} } |
a3e8bacb |
130 | map { $class->get_method($_) } |
131 | grep { $_ ne 'meta' } sort $class->get_method_list; |
132 | |
133 | my @method_specs = map{ $self->_method_info($_) } @methods; |
134 | my @attribute_specs = map{ $self->_attribute_info($_) } @attributes; |
135 | |
136 | #fix Moose::Meta::Role and apply the roles that were delayed |
137 | $rmeta->remove_method("apply"); |
138 | $rmeta->add_method("apply", $original_apply); |
139 | $rmeta->make_immutable; |
140 | #we apply roles to be able to figure out which ones we are using although I |
141 | #could just cycle through $_->[0] for @roles_to_apply; |
142 | shift(@$_)->apply(@$_) for @roles_to_apply; |
143 | |
144 | #Moose::Meta::Role and Class have different methods to get consumed roles.. |
145 | #make sure we break up composite roles as well to get better names and nicer |
146 | #linking to packages. |
3890b670 |
147 | my @roles = sort{ $a->name cmp $b->name } |
a3e8bacb |
148 | map { $_->isa("Moose::Meta::Role::Composite") ? @{ $_->get_roles } : $_ } |
149 | @{ $is_role ? $meta->get_roles : $meta->roles }; |
ec75fdb0 |
150 | my @role_specs = map{ $self->_consumed_role_info($_) } @roles; |
3890b670 |
151 | |
a3e8bacb |
152 | #fill up the spec |
153 | $spec->{name} = $meta->name; |
154 | $spec->{roles} = \ @role_specs; |
155 | $spec->{methods} = \ @method_specs; |
156 | $spec->{attributes} = \ @attribute_specs; |
3890b670 |
157 | |
158 | return $spec; |
159 | } |
160 | |
ec75fdb0 |
161 | sub _attribute_info{ |
3890b670 |
162 | my($self, $attr) = @_;; |
163 | my $attr_name = $attr->name; |
164 | my $spec = { name => $attr_name }; |
165 | my $info = $spec->{info} = {}; |
166 | |
167 | $info->{clearer} = $attr->clearer if $attr->has_clearer; |
168 | $info->{builder} = $attr->builder if $attr->has_builder; |
169 | $info->{predicate} = $attr->predicate if $attr->has_predicate; |
170 | |
171 | |
172 | my $description = $attr->is_required ? 'Required ' : 'Optional '; |
173 | if( defined(my $is = $attr->_is_metadata) ){ |
174 | $description .= 'read-only ' if $is eq 'ro'; |
175 | $description .= 'read-write ' if $is eq 'rw'; |
176 | |
177 | #If we have 'is' info only write out this info if it != attr_name |
178 | $info->{writer} = $attr->writer |
179 | if $attr->has_writer && $attr->writer ne $attr_name; |
180 | $info->{reader} = $attr->reader |
181 | if $attr->has_reader && $attr->reader ne $attr_name; |
182 | $info->{accessor} = $attr->accessor |
183 | if $attr->has_accessor && $attr->accessor ne $attr_name; |
184 | } else { |
185 | $info->{writer} = $attr->writer if $attr->has_writer; |
186 | $info->{reader} = $attr->reader if $attr->has_reader; |
187 | $info->{accessor} = $attr->accessor if $attr->has_accessor; |
188 | } |
a8676f0f |
189 | $info->{'constructor key'} = $attr->init_arg |
190 | if $attr->has_init_arg && $attr->init_arg ne $attr_name; |
3890b670 |
191 | |
192 | if( defined(my $lazy = $attr->is_lazy) ){ |
193 | $description .= 'lazy-building '; |
194 | } |
195 | $description .= 'value'; |
196 | if( defined(my $isa = $attr->_isa_metadata) ){ |
197 | my $link_to; |
198 | if( blessed $isa ){ |
199 | my $from_type_lib; |
200 | while( blessed $isa ){ |
201 | $isa = $isa->name; |
202 | } |
203 | my @parts = split '::', $isa; |
204 | my $type_name = pop @parts; |
205 | my $type_lib = join "::", @parts; |
206 | if(eval{$type_lib->isa("MooseX::Types::Base")}){ |
207 | $link_to = $type_lib; |
208 | $isa = $type_name; |
209 | } |
210 | } else { |
211 | my ($isa_base) = ($isa =~ /^(.*?)(?:\[.*\])?$/); |
212 | if (exists $self->tc_to_lib_map->{$isa_base}){ |
213 | $link_to = $self->tc_to_lib_map->{$isa_base}; |
214 | } |
215 | my $isa = $isa_base; |
216 | } |
217 | if(defined $link_to){ |
218 | $isa = "L<${isa}|${link_to}>"; |
219 | } |
220 | $description .= " of type ${isa}"; |
221 | } |
222 | if( $attr->should_auto_deref){ |
223 | $description .=" that will be automatically dereferenced by ". |
224 | "the reader / accessor"; |
225 | } |
226 | if( $attr->has_documentation ){ |
227 | $description .= "\n\n" . $attr->documentation; |
228 | } |
229 | $spec->{description} = $description; |
230 | |
231 | return $spec; |
232 | } |
233 | |
ec75fdb0 |
234 | sub _superclass_info { |
3890b670 |
235 | my($self, $superclass) = @_; |
236 | my $spec = { name => $superclass->name }; |
237 | return $spec; |
238 | } |
239 | |
ec75fdb0 |
240 | sub _method_info { |
3890b670 |
241 | my($self, $method) = @_; |
242 | my $spec = { name => $method->name }; |
243 | return $spec; |
244 | } |
245 | |
ec75fdb0 |
246 | sub _consumed_role_info { |
3890b670 |
247 | my($self, $role) = @_;; |
248 | my $spec = { name => $role->name }; |
249 | return $spec; |
250 | } |
251 | |
252 | 1; |
253 | |
254 | __END__; |
255 | |
ec75fdb0 |
256 | =head1 NAME |
257 | |
a3e8bacb |
258 | MooseX::AutoDoc - Automatically generate documentation for Moose-based packages |
ec75fdb0 |
259 | |
260 | =head1 SYNOPSYS |
261 | |
262 | use MooseX::AutoDoc; |
263 | my $autodoc = MooseX::AutoDoc->new |
264 | ( |
265 | authors => |
266 | [ |
267 | { |
268 | name => "Guillermo Roditi", |
269 | email => 'groditi@cpan.org', |
270 | handle => "groditi", |
271 | } |
272 | ], |
273 | ); |
274 | |
a3e8bacb |
275 | my $class_pod = $autodoc->generate_pod_for("MyClass"); |
276 | my $role_pod = $autodoc->generate_pod_for("MyRole"); |
ec75fdb0 |
277 | |
278 | =head1 DESCRIPTION |
279 | |
280 | MooseX::AutoDoc allows you to automatically generate POD documentation from |
a3e8bacb |
281 | your Moose based objects by introspecting them and creating a POD skeleton |
282 | with extra information where it can be infered through the MOP. |
ec75fdb0 |
283 | |
284 | =head1 NOTICE REGARDING ROLE CONSUMPTION |
285 | |
286 | To accurantely detect which methods and attributes are part of the class / role |
a3e8bacb |
287 | being examined and which are part of a consumed role the L</"generate_pod_for"> |
288 | method need to delay role consumption. If your role or class has been loaded |
289 | prior to calling these methods you run a risk of recieving inacurate data and |
290 | a warning will be emitted. This is due to the fact that once a role is applied |
291 | there is no way to tell which attributes and methods came from the class and |
292 | which came from the role. |
ec75fdb0 |
293 | |
294 | =head1 ATTRIBUTES |
295 | |
296 | Unless noted otherwise, you may set any of these attributes at C<new> time by |
297 | passing key / value pairs to C<new> where the key is the name of the attribute |
298 | you wish to set. Unless noted otherwise accessor methods for attributes also |
299 | share the same name as the attribute. |
300 | |
301 | =head2 authors |
302 | |
303 | =over 4 |
304 | |
305 | =item B<predicate> - has_authors |
306 | |
307 | =back |
308 | |
309 | Optional read-write value of type |
310 | L<ArrayRef[HashRef]|Moose::Util::TypeConstraints> representing the authors of |
311 | the class / role being documented. These values are passed directly to the view |
312 | and the default TT view accepts entries in the following form |
313 | (all fields optional) |
314 | |
315 | { |
316 | name => 'Guillermo Roditi', |
317 | handle => 'groditi', |
318 | email => '<groditi@gmail.com>', |
319 | } |
320 | |
321 | =head2 ignored_method_metaclasses |
322 | |
323 | =over 4 |
324 | |
325 | =item B<builder> - _build_ignored_method_metaclasses |
326 | |
327 | Default to the Moose and Class::MOP method metaclasses for generated methods, |
328 | accessors, and constructors. |
329 | |
330 | =item B<clearer> - clear_ignored_method_metaclasses |
331 | |
332 | =item B<predicate> - has_ignored_method_metaclasses |
333 | |
334 | =back |
335 | |
336 | Required read-write lazy-building value of type |
337 | L<HashRef|Moose::Util::TypeConstraints> where the keys are method metaclasses |
338 | MooseX::AutoDoc should ignore when creating a method list. |
339 | |
340 | =head2 license_text |
341 | |
342 | =over 4 |
343 | |
344 | =item B<builder> - _build_license_text |
345 | |
346 | =item B<clearer> - clear_license_text |
347 | |
348 | =item B<predicate> - has_license_text |
349 | |
350 | =back |
351 | |
352 | Required read-write lazy-building value of type |
353 | L<Str|Moose::Util::TypeConstraints>. By default it will use the following text: |
354 | |
355 | This library is free software; you can redistribute it and/or modify it |
356 | under the same terms as Perl itself. |
357 | |
358 | =head2 tc_to_lib_map |
359 | |
360 | =over 4 |
361 | |
362 | =item B<builder> - _build_tc_to_lib_map |
363 | |
364 | =item B<clearer> - clear_tc_to_lib_map |
365 | |
366 | =item B<predicate> - has_tc_to_lib_map |
367 | |
368 | =back |
369 | |
370 | Required read-write lazy-building value of type |
371 | L<HashRef|Moose::Util::TypeConstraints>. The keys refer to type constraint |
372 | names and the values to the module where the documentation available for that |
373 | type is. Please note that if you are using MooseX::Types libraries the links |
374 | will be automatically generated if the library class can be found (most cases). |
375 | |
376 | =head2 view |
377 | |
378 | =over 4 |
379 | |
380 | =item B<builder> - _build_view |
381 | |
382 | Returns 'MooseX::AutoDoc::View::TT' |
383 | |
384 | =item B<clearer> - clear_view |
385 | |
386 | =item B<predicate> - has_view |
387 | |
388 | =back |
389 | |
390 | Required read-write lazy-building value of type AutoDocView. The AutoDocView |
391 | type will accept an Object that isa L<MooseX::AutoDoc::View>. This attribute |
392 | will attempt to coerce string values to instances by treating them as class |
393 | names and attempting to load and instantiate a class of the same name. |
394 | |
395 | =head1 METHODS |
396 | |
397 | =head2 new $key => $value |
398 | |
399 | Instantiate a new object. Please refer to L</"ATTRIBUTES"> for a list of valid |
400 | key options. |
401 | |
a3e8bacb |
402 | =head2 generate_pod_for $package_name, $view_args |
ec75fdb0 |
403 | |
a3e8bacb |
404 | Returns a string containing the Pod for the package. To make sure the data is |
405 | accurate please make sure the package has not been loaded prior to this step. |
ec75fdb0 |
406 | for more info see L</"NOTICE REGARDING ROLE CONSUMPTION"> |
407 | |
a3e8bacb |
408 | =head2 _package_info $package_name |
ec75fdb0 |
409 | |
a3e8bacb |
410 | Will return a hashref representing the documentation components of the package |
411 | with the keys C<name>, C<attributes>, C<methods>, C<attributes> and--if the |
412 | case the package is a class--C<superclasses>; the latter four are array refs |
413 | of the hashrefs returned by L</"_superclass_info">, L</"_attribute_info">, |
414 | L</"_method_info">, and L</"_consumed_role_info"> respectively. |
ec75fdb0 |
415 | |
416 | =head2 _attribute_info $attr |
417 | |
418 | Accepts one argument, an attribute metaclass instance. |
419 | Returns a hashref representing the documentation components of the |
420 | attribute with the keys C<name>, C<description>, and C<info>, a hashref |
a3e8bacb |
421 | of additional information. If you have set the documentation attribute of |
422 | your attributes the documentation text will be appended to the auto-generated |
423 | description. |
ec75fdb0 |
424 | |
425 | =head2 _consumed_role_info $role |
426 | |
427 | Accepts one argument, a role metaclass instance. Returns a hashref representing |
428 | the documentation components of the role with the key C<name>. |
429 | |
430 | =head2 _method_info $method |
431 | |
432 | Accepts one argument, a method metaclass instance. Returns a hashref |
433 | representing the documentation components of the role with the key C<name>. |
434 | |
435 | =head2 _superclass_info $class |
436 | |
437 | Accepts one argument, the metaclass instance of a superclass. Returns a hashref |
438 | representing the documentation components of the role with the key C<name>. |
439 | |
440 | =head2 meta |
441 | |
442 | Retrieve the metaclass instance. Please see L<Moose::Meta::Class> and |
443 | L<Class::MOP::Class> for more information. |
444 | |
445 | =head1 AUTHORS |
446 | |
447 | Guillermo Roditi (Guillermo Roditi) <groditi@cpan.org> |
448 | |
449 | =head1 COPYRIGHT AND LICENSE |
3890b670 |
450 | |
ec75fdb0 |
451 | This library is free software; you can redistribute it and/or modify it under |
452 | the same terms as Perl itself. |
3890b670 |
453 | |
ec75fdb0 |
454 | =cut |