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