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::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,
61 # 'Moose::Meta::Role::Method' => 1,
62 # 'Moose::Meta::Method::Overridden' => 1,
63 # 'Class::MOP::Method::Wrapped' => 1,
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.";
73 sub generate_pod_for_role {
74 my ($self, $role, $view_args) = @_;
76 carp("${role} is already loaded. This will cause inacurate output.".
77 "if ${role} is the consumer of any roles.")
78 if Class::MOP::is_class_loaded( $role );
80 my $spec = $self->role_info($role);
83 license => $self->license_text,
84 authors => $self->has_authors ? $self->authors : [],
86 return $self->view->render_role($vars, $view_args);
90 sub generate_pod_for_class {
91 my ($self, $class, $view_args) = @_;
93 carp("${class} is already loaded. This will cause inacurate output.".
94 "if ${class} is the consumer of any roles.")
95 if Class::MOP::is_class_loaded( $class );
97 my $spec = $self->class_info($class);
100 license => $self->license_text,
101 authors => $self->has_authors ? $self->authors : [],
104 return $self->view->render_class($vars, $view_args);
110 my ($self, $role) = @_;
112 my (@roles_to_apply, $rmeta, $original_apply);
113 { #intercept role application so we can accurately generate
114 #method and attribute information for the parent class.
115 #this is fragile, but there is not better way that i am aware of
117 $rmeta = Moose::Meta::Role->meta;
118 $rmeta->make_mutable if $rmeta->is_immutable;
119 $original_apply = $rmeta->get_method("apply")->body;
120 $rmeta->remove_method("apply");
121 $rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])});
123 eval { Class::MOP::load_class($role); };
124 confess "Failed to load class ${role} $@" if $@;
127 my $meta = $role->meta;
128 my $anon = Moose::Meta::Class->create_anon_class;
129 $original_apply->($meta, $anon);
131 my @attributes = map{ $anon->get_attribute($_) } sort $anon->get_attribute_list;
134 grep{ ! exists $self->ignored_method_metaclasses->{$_->meta->name} }
135 map { $anon->get_method($_) }
136 grep { $_ ne 'meta' } #it wasnt getting filtered on the anon class..
137 sort $anon->get_method_list;
138 my @method_specs = map{ $self->_method_info($_) } @methods;
139 my @attribute_specs = map{ $self->_attribute_info($_) } @attributes;
141 { #fix Moose::Meta::Role and apply the roles that were delayed
142 $rmeta->remove_method("apply");
143 $rmeta->add_method("apply", $original_apply);
144 $rmeta->make_immutable;
145 shift(@$_)->apply(@$_) for @roles_to_apply;
149 sort{ $a->name cmp $b->name }
150 map { $_->isa("Moose::Meta::Role::Composite") ? @{$_->get_roles} : $_ }
151 @{ $meta->get_roles };
153 my @role_specs = map{ $self->_consumed_role_info($_) } @roles;
157 roles => \ @role_specs,
158 methods => \ @method_specs,
159 attributes => \ @attribute_specs,
167 my ($self, $class) = @_;
169 my (@roles_to_apply, $rmeta, $original_apply);
170 { #intercept role application so we can accurately generate
171 #method and attribute information for the parent class.
172 #this is fragile, but there is not better way that i am aware of
174 $rmeta = Moose::Meta::Role->meta;
175 $rmeta->make_mutable if $rmeta->is_immutable;
176 $original_apply = $rmeta->get_method("apply")->body;
177 $rmeta->remove_method("apply");
178 $rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])});
180 eval { Class::MOP::load_class($class); };
181 confess "Failed to load class ${class} $@" if $@;
184 my $meta = $class->meta;
186 my @attributes = map{ $meta->get_attribute($_) } sort $meta->get_attribute_list;
187 my @superclasses = map{ $_->meta }
188 grep { $_ ne 'Moose::Object' } $meta->superclasses;
191 grep{ ! exists $self->ignored_method_metaclasses->{$_->meta->name} }
192 map { $meta->get_method($_) }
193 grep { $_ ne 'meta' } #it wasnt getting filtered on the anon class..
194 sort $meta->get_method_list;
196 my @method_specs = map{ $self->_method_info($_) } @methods;
197 my @attribute_specs = map{ $self->_attribute_info($_) } @attributes;
198 my @superclass_specs = map{ $self->_superclass_info($_) } @superclasses;
200 { #fix Moose::Meta::Role and apply the roles that were delayed
201 $rmeta->remove_method("apply");
202 $rmeta->add_method("apply", $original_apply);
203 $rmeta->make_immutable;
204 shift(@$_)->apply(@$_) for @roles_to_apply;
207 my @roles = sort{ $a->name cmp $b->name }
208 map { $_->isa("Moose::Meta::Role::Composite") ? @{$_->get_roles} : $_ }
210 my @role_specs = map{ $self->_consumed_role_info($_) } @roles;
214 roles => \ @role_specs,
215 methods => \ @method_specs,
216 attributes => \ @attribute_specs,
217 superclasses => \ @superclass_specs,
224 my($self, $attr) = @_;;
225 my $attr_name = $attr->name;
226 my $spec = { name => $attr_name };
227 my $info = $spec->{info} = {};
229 $info->{clearer} = $attr->clearer if $attr->has_clearer;
230 $info->{builder} = $attr->builder if $attr->has_builder;
231 $info->{predicate} = $attr->predicate if $attr->has_predicate;
234 my $description = $attr->is_required ? 'Required ' : 'Optional ';
235 if( defined(my $is = $attr->_is_metadata) ){
236 $description .= 'read-only ' if $is eq 'ro';
237 $description .= 'read-write ' if $is eq 'rw';
239 #If we have 'is' info only write out this info if it != attr_name
240 $info->{writer} = $attr->writer
241 if $attr->has_writer && $attr->writer ne $attr_name;
242 $info->{reader} = $attr->reader
243 if $attr->has_reader && $attr->reader ne $attr_name;
244 $info->{accessor} = $attr->accessor
245 if $attr->has_accessor && $attr->accessor ne $attr_name;
247 $info->{writer} = $attr->writer if $attr->has_writer;
248 $info->{reader} = $attr->reader if $attr->has_reader;
249 $info->{accessor} = $attr->accessor if $attr->has_accessor;
251 $info->{'constructor key'} = $attr->init_arg
252 if $attr->has_init_arg && $attr->init_arg ne $attr_name;
254 if( defined(my $lazy = $attr->is_lazy) ){
255 $description .= 'lazy-building ';
257 $description .= 'value';
258 if( defined(my $isa = $attr->_isa_metadata) ){
262 while( blessed $isa ){
265 my @parts = split '::', $isa;
266 my $type_name = pop @parts;
267 my $type_lib = join "::", @parts;
268 if(eval{$type_lib->isa("MooseX::Types::Base")}){
269 $link_to = $type_lib;
273 my ($isa_base) = ($isa =~ /^(.*?)(?:\[.*\])?$/);
274 if (exists $self->tc_to_lib_map->{$isa_base}){
275 $link_to = $self->tc_to_lib_map->{$isa_base};
279 if(defined $link_to){
280 $isa = "L<${isa}|${link_to}>";
282 $description .= " of type ${isa}";
284 if( $attr->should_auto_deref){
285 $description .=" that will be automatically dereferenced by ".
286 "the reader / accessor";
288 if( $attr->has_documentation ){
289 $description .= "\n\n" . $attr->documentation;
291 $spec->{description} = $description;
296 sub _superclass_info {
297 my($self, $superclass) = @_;
298 my $spec = { name => $superclass->name };
303 my($self, $method) = @_;
304 my $spec = { name => $method->name };
308 sub _consumed_role_info {
309 my($self, $role) = @_;;
310 my $spec = { name => $role->name };
320 MooseX::AutoDoc - Automatically generate documentation for Moose-based classes
325 my $autodoc = MooseX::AutoDoc->new
330 name => "Guillermo Roditi",
331 email => 'groditi@cpan.org',
337 my $class_pod = $autodoc->generate_pod_for_class("MyClass");
338 my $role_pod = $autodoc->generate_pod_for_role("MyRole");
342 MooseX::AutoDoc allows you to automatically generate POD documentation from
343 your Moose based objects by introspecting them and creating a
345 =head1 NOTICE REGARDING ROLE CONSUMPTION
347 To accurantely detect which methods and attributes are part of the class / role
348 being examined and which are part of a consumed role the
349 L</"generate_pod_for_role"> and L</"generate_pod_for_class"> methods need to
350 delay role consumption. If your role or class has been loaded prior to calling
351 these methods you run a risk of recieving inacurate data and a warning will be
356 Unless noted otherwise, you may set any of these attributes at C<new> time by
357 passing key / value pairs to C<new> where the key is the name of the attribute
358 you wish to set. Unless noted otherwise accessor methods for attributes also
359 share the same name as the attribute.
365 =item B<predicate> - has_authors
369 Optional read-write value of type
370 L<ArrayRef[HashRef]|Moose::Util::TypeConstraints> representing the authors of
371 the class / role being documented. These values are passed directly to the view
372 and the default TT view accepts entries in the following form
373 (all fields optional)
376 name => 'Guillermo Roditi',
378 email => '<groditi@gmail.com>',
381 =head2 ignored_method_metaclasses
385 =item B<builder> - _build_ignored_method_metaclasses
387 Default to the Moose and Class::MOP method metaclasses for generated methods,
388 accessors, and constructors.
390 =item B<clearer> - clear_ignored_method_metaclasses
392 =item B<predicate> - has_ignored_method_metaclasses
396 Required read-write lazy-building value of type
397 L<HashRef|Moose::Util::TypeConstraints> where the keys are method metaclasses
398 MooseX::AutoDoc should ignore when creating a method list.
404 =item B<builder> - _build_license_text
406 =item B<clearer> - clear_license_text
408 =item B<predicate> - has_license_text
412 Required read-write lazy-building value of type
413 L<Str|Moose::Util::TypeConstraints>. By default it will use the following text:
415 This library is free software; you can redistribute it and/or modify it
416 under the same terms as Perl itself.
422 =item B<builder> - _build_tc_to_lib_map
424 =item B<clearer> - clear_tc_to_lib_map
426 =item B<predicate> - has_tc_to_lib_map
430 Required read-write lazy-building value of type
431 L<HashRef|Moose::Util::TypeConstraints>. The keys refer to type constraint
432 names and the values to the module where the documentation available for that
433 type is. Please note that if you are using MooseX::Types libraries the links
434 will be automatically generated if the library class can be found (most cases).
440 =item B<builder> - _build_view
442 Returns 'MooseX::AutoDoc::View::TT'
444 =item B<clearer> - clear_view
446 =item B<predicate> - has_view
450 Required read-write lazy-building value of type AutoDocView. The AutoDocView
451 type will accept an Object that isa L<MooseX::AutoDoc::View>. This attribute
452 will attempt to coerce string values to instances by treating them as class
453 names and attempting to load and instantiate a class of the same name.
457 =head2 new $key => $value
459 Instantiate a new object. Please refer to L</"ATTRIBUTES"> for a list of valid
462 =head2 generate_pod_for_class $class_name, $view_args
464 Returns a string containing the Pod for the class. To make sure the data is
465 accurate please make sure the class has not been loaded prior to this step.
466 for more info see L</"NOTICE REGARDING ROLE CONSUMPTION">
468 =head2 generate_pod_for_role $role_name, $view_args
470 Returns a string containing the Pod for the role.To make sure the data is
471 accurate please make sure the role has not been loaded prior to this step.
472 for more info see L</"NOTICE REGARDING ROLE CONSUMPTION">
474 =head2 _class_info $class_name
476 Will return a hashref representing the documentation components of the class
477 with the keys C<name>, C<superclasses>, C<attributes>, C<methods> and,
478 C<attributes>; the latter four representing array refs of the hashrefs returned
479 by L</"_superclass_info">, L</"_attribute_info">, L</"_method_info">, and
480 L</"_consumed_role_info">
482 =head2 _role_info $role_name
484 Will return a hashref representing the documentation components of the role
485 with the keys C<name>, C<attributes>, C<methods> and, C<attributes>; the
486 latter three representing array refs of the hashrefs returned by
487 L</"_attribute_info">, L</"_method_info">, and L</"_consumed_role_info">
489 =head2 _attribute_info $attr
491 Accepts one argument, an attribute metaclass instance.
492 Returns a hashref representing the documentation components of the
493 attribute with the keys C<name>, C<description>, and C<info>, a hashref
494 of additional information.
496 =head2 _consumed_role_info $role
498 Accepts one argument, a role metaclass instance. Returns a hashref representing
499 the documentation components of the role with the key C<name>.
501 =head2 _method_info $method
503 Accepts one argument, a method metaclass instance. Returns a hashref
504 representing the documentation components of the role with the key C<name>.
506 =head2 _superclass_info $class
508 Accepts one argument, the metaclass instance of a superclass. Returns a hashref
509 representing the documentation components of the role with the key C<name>.
513 Retrieve the metaclass instance. Please see L<Moose::Meta::Class> and
514 L<Class::MOP::Class> for more information.
518 Guillermo Roditi (Guillermo Roditi) <groditi@cpan.org>
520 =head1 COPYRIGHT AND LICENSE
522 This library is free software; you can redistribute it and/or modify it under
523 the same terms as Perl itself.