blib/lib/MooseX/AutoDoc.pm

   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 {
  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
  61 #          'Moose::Meta::Role::Method'        => 1,
  62 #          'Moose::Meta::Method::Overridden'  => 1,
  63 #          'Class::MOP::Method::Wrapped'      => 1,
  64
  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
  73 sub generate_pod_for_role {
  74   my ($self, $role, $view_args) = @_;
  75
  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 );
  79
  80   my $spec = $self->role_info($role);
  81   my $vars = {
  82               role    => $spec,
  83               license => $self->license_text,
  84               authors => $self->has_authors ? $self->authors : [],
  85              };
  86   return $self->view->render_role($vars, $view_args);
  87 }
  88
  89 #make the actual POD
  90 sub generate_pod_for_class {
  91   my ($self, $class, $view_args) = @_;
  92
  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 );
  96
  97   my $spec = $self->class_info($class);
  98   my $vars = {
  99               class   => $spec,
 100               license => $self->license_text,
 101               authors => $self->has_authors ? $self->authors : [],
 102              };
 103
 104   return $self->view->render_class($vars, $view_args);
 105 }
 106
 107
 108 # *_info methods
 109 sub _role_info {
 110   my ($self, $role) = @_;
 111
 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
 116
 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, [@_])});
 122
 123     eval { Class::MOP::load_class($role); };
 124     confess "Failed to load class ${role} $@" if $@;
 125   }
 126
 127   my $meta =  $role->meta;
 128   my $anon = Moose::Meta::Class->create_anon_class;
 129   $original_apply->($meta, $anon);
 130
 131   my @attributes = map{ $anon->get_attribute($_) } sort $anon->get_attribute_list;
 132
 133   my @methods =
 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;
 140
 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;
 146   }
 147
 148   my @roles =
 149     sort{ $a->name cmp $b->name }
 150       map { $_->isa("Moose::Meta::Role::Composite") ? @{$_->get_roles} : $_ }
 151         @{ $meta->get_roles };
 152
 153   my @role_specs = map{ $self->_consumed_role_info($_) } @roles;
 154
 155   my $spec = {
 156               name         => $meta->name,
 157               roles        => \ @role_specs,
 158               methods      => \ @method_specs,
 159               attributes   => \ @attribute_specs,
 160              };
 161
 162   return $spec;
 163 }
 164
 165
 166 sub _class_info {
 167   my ($self, $class) = @_;
 168
 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
 173
 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, [@_])});
 179
 180     eval { Class::MOP::load_class($class); };
 181     confess "Failed to load class ${class} $@" if $@;
 182   }
 183
 184   my $meta = $class->meta;
 185
 186   my @attributes   = map{ $meta->get_attribute($_) } sort $meta->get_attribute_list;
 187   my @superclasses = map{ $_->meta }
 188     grep { $_ ne 'Moose::Object' } $meta->superclasses;
 189
 190   my @methods =
 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;
 195
 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;
 199
 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;
 205   }
 206
 207   my @roles = sort{ $a->name cmp $b->name }
 208     map { $_->isa("Moose::Meta::Role::Composite") ? @{$_->get_roles} : $_ }
 209       @{ $meta->roles };
 210   my @role_specs = map{ $self->_consumed_role_info($_) } @roles;
 211
 212   my $spec = {
 213               name         => $meta->name,
 214               roles        => \ @role_specs,
 215               methods      => \ @method_specs,
 216               attributes   => \ @attribute_specs,
 217               superclasses => \ @superclass_specs,
 218              };
 219
 220   return $spec;
 221 }
 222
 223 sub _attribute_info{
 224   my($self, $attr) = @_;;
 225   my $attr_name = $attr->name;
 226   my $spec = { name => $attr_name };
 227   my $info = $spec->{info} = {};
 228
 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;
 232
 233
 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';
 238
 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;
 246   } else {
 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;
 250   }
 251   $info->{'constructor key'} = $attr->init_arg
 252     if $attr->has_init_arg && $attr->init_arg ne $attr_name;
 253
 254   if( defined(my $lazy = $attr->is_lazy) ){
 255     $description .= 'lazy-building ';
 256   }
 257   $description .= 'value';
 258   if( defined(my $isa = $attr->_isa_metadata) ){
 259     my $link_to;
 260     if( blessed $isa ){
 261       my $from_type_lib;
 262       while( blessed $isa ){
 263         $isa = $isa->name;
 264       }
 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;
 270         $isa = $type_name;
 271       }
 272     } else {
 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};
 276       }
 277       my $isa = $isa_base;
 278     }
 279     if(defined $link_to){
 280       $isa = "L<${isa}|${link_to}>";
 281     }
 282     $description .= " of type ${isa}";
 283   }
 284   if( $attr->should_auto_deref){
 285     $description .=" that will be automatically dereferenced by ".
 286       "the reader / accessor";
 287   }
 288   if( $attr->has_documentation ){
 289     $description .= "\n\n" . $attr->documentation;
 290   }
 291   $spec->{description} = $description;
 292
 293   return $spec;
 294 }
 295
 296 sub _superclass_info {
 297   my($self, $superclass) = @_;
 298   my $spec = { name => $superclass->name };
 299   return $spec;
 300 }
 301
 302 sub _method_info {
 303   my($self, $method) = @_;
 304   my $spec = { name => $method->name };
 305   return $spec;
 306 }
 307
 308 sub _consumed_role_info {
 309   my($self, $role) = @_;;
 310   my $spec = { name => $role->name };
 311   return $spec;
 312 }
 313
 314 1;
 315
 316 __END__;
 317
 318 =head1 NAME
 319
 320 MooseX::AutoDoc - Automatically generate documentation for Moose-based classes
 321
 322 =head1 SYNOPSYS
 323
 324     use MooseX::AutoDoc;
 325     my $autodoc = MooseX::AutoDoc->new
 326       (
 327        authors =>
 328         [
 329          {
 330           name => "Guillermo Roditi",
 331           email => 'groditi@cpan.org',
 332           handle => "groditi",
 333          }
 334         ],
 335       );
 336
 337     my $class_pod = $autodoc->generate_pod_for_class("MyClass");
 338     my $role_pod  = $autodoc->generate_pod_for_role("MyRole");
 339
 340 =head1 DESCRIPTION
 341
 342 MooseX::AutoDoc allows you to automatically generate POD documentation from
 343 your Moose based objects by introspecting them and creating a
 344
 345 =head1 NOTICE REGARDING ROLE CONSUMPTION
 346
 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
 352 emitted.
 353
 354 =head1 ATTRIBUTES
 355
 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.
 360
 361 =head2 authors
 362
 363 =over 4
 364
 365 =item B<predicate> - has_authors
 366
 367 =back
 368
 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)
 374
 375   {
 376    name   => 'Guillermo Roditi',
 377    handle => 'groditi',
 378    email  => '<groditi@gmail.com>',
 379   }
 380
 381 =head2 ignored_method_metaclasses
 382
 383 =over 4
 384
 385 =item B<builder> - _build_ignored_method_metaclasses
 386
 387 Default to the Moose and Class::MOP method metaclasses for generated methods,
 388 accessors, and constructors.
 389
 390 =item B<clearer> - clear_ignored_method_metaclasses
 391
 392 =item B<predicate> - has_ignored_method_metaclasses
 393
 394 =back
 395
 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.
 399
 400 =head2 license_text
 401
 402 =over 4
 403
 404 =item B<builder> - _build_license_text
 405
 406 =item B<clearer> - clear_license_text
 407
 408 =item B<predicate> - has_license_text
 409
 410 =back
 411
 412 Required read-write lazy-building value of type
 413 L<Str|Moose::Util::TypeConstraints>. By default it will use the following text:
 414
 415     This library is free software; you can redistribute it and/or modify it
 416     under the same terms as Perl itself.
 417
 418 =head2 tc_to_lib_map
 419
 420 =over 4
 421
 422 =item B<builder> - _build_tc_to_lib_map
 423
 424 =item B<clearer> - clear_tc_to_lib_map
 425
 426 =item B<predicate> - has_tc_to_lib_map
 427
 428 =back
 429
 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).
 435
 436 =head2 view
 437
 438 =over 4
 439
 440 =item B<builder> - _build_view
 441
 442 Returns 'MooseX::AutoDoc::View::TT'
 443
 444 =item B<clearer> - clear_view
 445
 446 =item B<predicate> - has_view
 447
 448 =back
 449
 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.
 454
 455 =head1 METHODS
 456
 457 =head2 new $key => $value
 458
 459 Instantiate a new object. Please refer to L</"ATTRIBUTES"> for a list of valid
 460 key options.
 461
 462 =head2 generate_pod_for_class $class_name, $view_args
 463
 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">
 467
 468 =head2 generate_pod_for_role $role_name, $view_args
 469
 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">
 473
 474 =head2 _class_info $class_name
 475
 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">
 481
 482 =head2 _role_info $role_name
 483
 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">
 488
 489 =head2 _attribute_info $attr
 490
 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.
 495
 496 =head2 _consumed_role_info $role
 497
 498 Accepts one argument, a role metaclass instance. Returns a hashref representing
 499 the documentation components of the role with the key C<name>.
 500
 501 =head2 _method_info $method
 502
 503 Accepts one argument, a method metaclass instance. Returns a hashref
 504 representing the documentation components of the role with the key C<name>.
 505
 506 =head2 _superclass_info $class
 507
 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>.
 510
 511 =head2 meta
 512
 513 Retrieve the metaclass instance. Please see L<Moose::Meta::Class> and
 514 L<Class::MOP::Class> for more information.
 515
 516 =head1 AUTHORS
 517
 518 Guillermo Roditi (Guillermo Roditi) <groditi@cpan.org>
 519
 520 =head1 COPYRIGHT AND LICENSE
 521
 522 This library is free software; you can redistribute it and/or modify it under
 523 the same terms as Perl itself.
 524
 525 =cut