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