[gitmo/MooseX-AutoDoc.git] / blib / lib / MooseX / AutoDoc.pm

package MooseX::AutoDoc;

use Moose;
use Carp;
use Class::MOP;
use Moose::Meta::Role;
use Moose::Meta::Class;
use Scalar::Util qw/blessed/;

#  Create a special TypeConstraint for the View so you can just set it
# with a class name and it'll DWIM
{
  use Moose::Util::TypeConstraints;

  subtype 'AutoDocView'
    => as 'Object'
      => where { $_->isa('MooseX::AutoDoc::View') }
        => message { "Value should be a subclass of MooseX::AutoDoc::View" } ;

  coerce 'AutoDocView'
    => from  'Str'
      => via { Class::MOP::load_class($_); $_->new };

  no Moose::Util::TypeConstraints;
}

#view object
has view => (is => 'rw', isa => 'AutoDocView', coerce => 1, lazy_build => 1);

#type constraint library to name mapping to make nice links
has tc_to_lib_map => (is => 'rw', isa => 'HashRef', lazy_build => 1);

#method metaclasses to ignore to avoid documenting some methods
has ignored_method_metaclasses => (is => 'rw', isa => 'HashRef', lazy_build => 1);

#defaults to artistic...
has license_text => (is => 'rw', isa => 'Str', lazy_build => 1);

#how can i get the data about the current user?
has authors      => (is => 'rw', isa => 'ArrayRef[HashRef]',
                     predicate => 'has_authors');

sub _build_view { "MooseX::AutoDoc::View::TT" }

sub _build_tc_to_lib_map {
  my %types = map {$_ => 'Moose::Util::TypeConstraints'}
    qw/Any Item Bool Undef Defined Value Num Int Str Role Maybe ClassName Ref
       ScalarRef ArrayRef HashRef CodeRef RegexpRef GlobRef FileHandle Object/;
  return \ %types;
}

sub _build_ignored_method_metaclasses {
  return {
          'Moose::Meta::Method::Accessor'    => 1,
          'Moose::Meta::Method::Constructor' => 1,
          'Class::MOP::Method::Accessor'     => 1,
          'Class::MOP::Method::Generated'    => 1,
          'Class::MOP::Method::Constructor'  => 1,
         };

#          'Moose::Meta::Role::Method'        => 1,
#          'Moose::Meta::Method::Overridden'  => 1,
#          'Class::MOP::Method::Wrapped'      => 1,

}

sub _build_license_text {
  "This library is free software; you can redistribute it and/or modify it "
    ."under the same terms as Perl itself.";
}

#make the actual POD
sub generate_pod_for_role {
  my ($self, $role, $view_args) = @_;

  carp("${role} is already loaded. This will cause inacurate output.".
       "if ${role} is the consumer of any roles.")
    if Class::MOP::is_class_loaded( $role );

  my $spec = $self->role_info($role);
  my $vars = {
              role    => $spec,
              license => $self->license_text,
              authors => $self->has_authors ? $self->authors : [],
             };
  return $self->view->render_role($vars, $view_args);
}

#make the actual POD
sub generate_pod_for_class {
  my ($self, $class, $view_args) = @_;

  carp("${class} is already loaded. This will cause inacurate output.".
       "if ${class} is the consumer of any roles.")
    if Class::MOP::is_class_loaded( $class );

  my $spec = $self->class_info($class);
  my $vars = {
              class   => $spec,
              license => $self->license_text,
              authors => $self->has_authors ? $self->authors : [],
             };

  return $self->view->render_class($vars, $view_args);
}


# *_info methods
sub _role_info {
  my ($self, $role) = @_;

  my (@roles_to_apply, $rmeta, $original_apply);
  {    #intercept role application so we can accurately generate
       #method and attribute information for the parent class.
       #this is fragile, but there is not better way that i am aware of

    $rmeta = Moose::Meta::Role->meta;
    $rmeta->make_mutable if $rmeta->is_immutable;
    $original_apply = $rmeta->get_method("apply")->body;
    $rmeta->remove_method("apply");
    $rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])});

    eval { Class::MOP::load_class($role); };
    confess "Failed to load class ${role} $@" if $@;
  }

  my $meta =  $role->meta;
  my $anon = Moose::Meta::Class->create_anon_class;
  $original_apply->($meta, $anon);

  my @attributes = map{ $anon->get_attribute($_) } sort $anon->get_attribute_list;

  my @methods =
    grep{ ! exists $self->ignored_method_metaclasses->{$_->meta->name} }
      map { $anon->get_method($_) }
        grep { $_ ne 'meta' }    #it wasnt getting filtered on the anon class..
          sort $anon->get_method_list;
  my @method_specs     = map{ $self->_method_info($_)        } @methods;
  my @attribute_specs  = map{ $self->_attribute_info($_)     } @attributes;

  { #fix Moose::Meta::Role and apply the roles that were delayed
    $rmeta->remove_method("apply");
    $rmeta->add_method("apply", $original_apply);
    $rmeta->make_immutable;
    shift(@$_)->apply(@$_) for @roles_to_apply;
  }

  my @roles =
    sort{ $a->name cmp $b->name }
      map { $_->isa("Moose::Meta::Role::Composite") ? @{$_->get_roles} : $_ }
        @{ $meta->get_roles };

  my @role_specs = map{ $self->_consumed_role_info($_) } @roles;

  my $spec = {
              name         => $meta->name,
              roles        => \ @role_specs,
              methods      => \ @method_specs,
              attributes   => \ @attribute_specs,
             };

  return $spec;
}


sub _class_info {
  my ($self, $class) = @_;

  my (@roles_to_apply, $rmeta, $original_apply);
  {    #intercept role application so we can accurately generate
       #method and attribute information for the parent class.
       #this is fragile, but there is not better way that i am aware of

    $rmeta = Moose::Meta::Role->meta;
    $rmeta->make_mutable if $rmeta->is_immutable;
    $original_apply = $rmeta->get_method("apply")->body;
    $rmeta->remove_method("apply");
    $rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])});

    eval { Class::MOP::load_class($class); };
    confess "Failed to load class ${class} $@" if $@;
  }

  my $meta = $class->meta;

  my @attributes   = map{ $meta->get_attribute($_) } sort $meta->get_attribute_list;
  my @superclasses = map{ $_->meta }
    grep { $_ ne 'Moose::Object' } $meta->superclasses;

  my @methods =
    grep{ ! exists $self->ignored_method_metaclasses->{$_->meta->name} }
      map { $meta->get_method($_) }
        grep { $_ ne 'meta' }    #it wasnt getting filtered on the anon class..
          sort $meta->get_method_list;

  my @method_specs     = map{ $self->_method_info($_)        } @methods;
  my @attribute_specs  = map{ $self->_attribute_info($_)     } @attributes;
  my @superclass_specs = map{ $self->_superclass_info($_)    } @superclasses;

  { #fix Moose::Meta::Role and apply the roles that were delayed
    $rmeta->remove_method("apply");
    $rmeta->add_method("apply", $original_apply);
    $rmeta->make_immutable;
    shift(@$_)->apply(@$_) for @roles_to_apply;
  }

  my @roles = sort{ $a->name cmp $b->name }
    map { $_->isa("Moose::Meta::Role::Composite") ? @{$_->get_roles} : $_ }
      @{ $meta->roles };
  my @role_specs = map{ $self->_consumed_role_info($_) } @roles;

  my $spec = {
              name         => $meta->name,
              roles        => \ @role_specs,
              methods      => \ @method_specs,
              attributes   => \ @attribute_specs,
              superclasses => \ @superclass_specs,
             };

  return $spec;
}

sub _attribute_info{
  my($self, $attr) = @_;;
  my $attr_name = $attr->name;
  my $spec = { name => $attr_name };
  my $info = $spec->{info} = {};

  $info->{clearer}   = $attr->clearer   if $attr->has_clearer;
  $info->{builder}   = $attr->builder   if $attr->has_builder;
  $info->{predicate} = $attr->predicate if $attr->has_predicate;


  my $description = $attr->is_required ? 'Required ' : 'Optional ';
  if( defined(my $is = $attr->_is_metadata) ){
    $description .= 'read-only '  if $is eq 'ro';
    $description .= 'read-write ' if $is eq 'rw';

    #If we have 'is' info only write out this info if it != attr_name
    $info->{writer} = $attr->writer
      if $attr->has_writer && $attr->writer ne $attr_name;
    $info->{reader} = $attr->reader
      if $attr->has_reader && $attr->reader ne $attr_name;
    $info->{accessor} = $attr->accessor
      if $attr->has_accessor && $attr->accessor ne $attr_name;
  } else {
    $info->{writer} = $attr->writer     if $attr->has_writer;
    $info->{reader} = $attr->reader     if $attr->has_reader;
    $info->{accessor} = $attr->accessor if $attr->has_accessor;
  }
  $info->{'constructor key'} = $attr->init_arg
    if $attr->has_init_arg && $attr->init_arg ne $attr_name;

  if( defined(my $lazy = $attr->is_lazy) ){
    $description .= 'lazy-building ';
  }
  $description .= 'value';
  if( defined(my $isa = $attr->_isa_metadata) ){
    my $link_to;
    if( blessed $isa ){
      my $from_type_lib;
      while( blessed $isa ){
        $isa = $isa->name;
      }
      my @parts = split '::', $isa;
      my $type_name = pop @parts;
      my $type_lib = join "::", @parts;
      if(eval{$type_lib->isa("MooseX::Types::Base")}){
        $link_to = $type_lib;
        $isa = $type_name;
      }
    } else {
      my ($isa_base) = ($isa =~ /^(.*?)(?:\[.*\])?$/);
      if (exists $self->tc_to_lib_map->{$isa_base}){
        $link_to = $self->tc_to_lib_map->{$isa_base};
      }
      my $isa = $isa_base;
    }
    if(defined $link_to){
      $isa = "L<${isa}|${link_to}>";
    }
    $description .= " of type ${isa}";
  }
  if( $attr->should_auto_deref){
    $description .=" that will be automatically dereferenced by ".
      "the reader / accessor";
  }
  if( $attr->has_documentation ){
    $description .= "\n\n" . $attr->documentation;
  }
  $spec->{description} = $description;

  return $spec;
}

sub _superclass_info {
  my($self, $superclass) = @_;
  my $spec = { name => $superclass->name };
  return $spec;
}

sub _method_info {
  my($self, $method) = @_;
  my $spec = { name => $method->name };
  return $spec;
}

sub _consumed_role_info {
  my($self, $role) = @_;;
  my $spec = { name => $role->name };
  return $spec;
}

1;

__END__;

=head1 NAME

MooseX::AutoDoc - Automatically generate documentation for Moose-based classes

=head1 SYNOPSYS

    use MooseX::AutoDoc;
    my $autodoc = MooseX::AutoDoc->new
      (
       authors =>
        [
         {
          name => "Guillermo Roditi",
          email => 'groditi@cpan.org',
          handle => "groditi",
         }
        ],
      );

    my $class_pod = $autodoc->generate_pod_for_class("MyClass");
    my $role_pod  = $autodoc->generate_pod_for_role("MyRole");

=head1 DESCRIPTION

MooseX::AutoDoc allows you to automatically generate POD documentation from
your Moose based objects by introspecting them and creating a

=head1 NOTICE REGARDING ROLE CONSUMPTION

To accurantely detect which methods and attributes are part of the class / role
being examined and which are part of a consumed role the
L</"generate_pod_for_role"> and  L</"generate_pod_for_class"> methods need to
delay role consumption. If your role or class has been loaded prior to calling
these methods you run a risk of recieving inacurate data and a warning will be
emitted.

=head1 ATTRIBUTES

Unless noted otherwise, you may set any of these attributes at C<new> time by
passing key / value pairs to C<new> where the key is the name of the attribute
you wish to set. Unless noted otherwise accessor methods for attributes also
share the same name as the attribute.

=head2 authors

=over 4

=item B<predicate> - has_authors

=back

Optional read-write value of type
L<ArrayRef[HashRef]|Moose::Util::TypeConstraints> representing the authors of
the class / role being documented. These values are passed directly to the view
and the default TT view accepts entries in the following form
(all fields optional)

  {
   name   => 'Guillermo Roditi',
   handle => 'groditi',
   email  => '<groditi@gmail.com>',
  }

=head2 ignored_method_metaclasses

=over 4

=item B<builder> - _build_ignored_method_metaclasses

Default to the Moose and Class::MOP method metaclasses for generated methods,
accessors, and constructors.

=item B<clearer> - clear_ignored_method_metaclasses

=item B<predicate> - has_ignored_method_metaclasses

=back

Required read-write lazy-building value of type
L<HashRef|Moose::Util::TypeConstraints> where the keys are method metaclasses
MooseX::AutoDoc should ignore when creating a method list.

=head2 license_text

=over 4

=item B<builder> - _build_license_text

=item B<clearer> - clear_license_text

=item B<predicate> - has_license_text

=back

Required read-write lazy-building value of type
L<Str|Moose::Util::TypeConstraints>. By default it will use the following text:

    This library is free software; you can redistribute it and/or modify it
    under the same terms as Perl itself.

=head2 tc_to_lib_map

=over 4

=item B<builder> - _build_tc_to_lib_map

=item B<clearer> - clear_tc_to_lib_map

=item B<predicate> - has_tc_to_lib_map

=back

Required read-write lazy-building value of type
L<HashRef|Moose::Util::TypeConstraints>. The keys refer to type constraint
names and the values to the module where the documentation available for that
type is. Please note that if you are using MooseX::Types libraries the links
will be automatically generated if the library class can be found (most cases).

=head2 view

=over 4

=item B<builder> - _build_view

Returns 'MooseX::AutoDoc::View::TT'

=item B<clearer> - clear_view

=item B<predicate> - has_view

=back

Required read-write lazy-building value of type AutoDocView. The AutoDocView
type will accept an Object that isa L<MooseX::AutoDoc::View>. This attribute
will attempt to coerce string values to instances by treating them as class
names and attempting to load and instantiate a class of the same name.

=head1 METHODS

=head2 new $key => $value

Instantiate a new object. Please refer to L</"ATTRIBUTES"> for a list of valid
key options.

=head2 generate_pod_for_class $class_name, $view_args

Returns a string containing the Pod for the class. To make sure the data is
accurate please make sure the class has not been loaded prior to this step.
for more info see L</"NOTICE REGARDING ROLE CONSUMPTION">

=head2 generate_pod_for_role $role_name, $view_args

Returns a string containing the Pod for the role.To make sure the data is
accurate please make sure the role has not been loaded prior to this step.
for more info see L</"NOTICE REGARDING ROLE CONSUMPTION">

=head2 _class_info $class_name

Will return a hashref representing the documentation components of the class
with the keys C<name>, C<superclasses>, C<attributes>, C<methods> and,
C<attributes>; the latter four representing array refs of the hashrefs returned
by L</"_superclass_info">, L</"_attribute_info">, L</"_method_info">, and
L</"_consumed_role_info">

=head2 _role_info $role_name

Will return a hashref representing the documentation components of the role
with the keys C<name>, C<attributes>, C<methods> and, C<attributes>; the
latter three representing array refs of the hashrefs returned by
L</"_attribute_info">, L</"_method_info">, and L</"_consumed_role_info">

=head2 _attribute_info $attr

Accepts one argument, an attribute metaclass instance.
Returns a hashref representing the documentation components of the
attribute with the keys C<name>, C<description>, and C<info>, a hashref
of additional information.

=head2 _consumed_role_info $role

Accepts one argument, a role metaclass instance. Returns a hashref representing
the documentation components of the role with the key C<name>.

=head2 _method_info $method

Accepts one argument, a method metaclass instance. Returns a hashref
representing the documentation components of the role with the key C<name>.

=head2 _superclass_info $class

Accepts one argument, the metaclass instance of a superclass. Returns a hashref
representing the documentation components of the role with the key C<name>.

=head2 meta

Retrieve the metaclass instance. Please see L<Moose::Meta::Class> and
L<Class::MOP::Class> for more information.

=head1 AUTHORS

Guillermo Roditi (Guillermo Roditi) <groditi@cpan.org>

=head1 COPYRIGHT AND LICENSE

This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut
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,
3890b670	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
	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
ec75fdb0	109	sub _role_info {
3890b670	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
3890b670	133	my @methods =
ec75fdb0	134	grep{ ! exists $self->ignored_method_metaclasses->{$_->meta->name} }
3890b670	135	map { $anon->get_method($_) }
	136	grep { $_ ne 'meta' } #it wasnt getting filtered on the anon class..
	137	sort $anon->get_method_list;
ec75fdb0	138	my @method_specs = map{ $self->_method_info($_) } @methods;
ec75fdb0	139	my @attribute_specs = map{ $self->_attribute_info($_) } @attributes;
3890b670	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
ec75fdb0	153	my @role_specs = map{ $self->_consumed_role_info($_) } @roles;
3890b670	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
ec75fdb0	166	sub _class_info {
3890b670	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
ec75fdb0	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;
3890b670	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 };
ec75fdb0	210	my @role_specs = map{ $self->_consumed_role_info($_) } @roles;
3890b670	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
ec75fdb0	223	sub _attribute_info{
3890b670	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	}
a8676f0f	251	$info->{'constructor key'} = $attr->init_arg
a8676f0f	252	if $attr->has_init_arg && $attr->init_arg ne $attr_name;
3890b670	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
ec75fdb0	296	sub _superclass_info {
3890b670	297	my($self, $superclass) = @_;
	298	my $spec = { name => $superclass->name };
	299	return $spec;
	300	}
	301
ec75fdb0	302	sub _method_info {
3890b670	303	my($self, $method) = @_;
	304	my $spec = { name => $method->name };
	305	return $spec;
	306	}
	307
ec75fdb0	308	sub _consumed_role_info {
3890b670	309	my($self, $role) = @_;;
	310	my $spec = { name => $role->name };
	311	return $spec;
	312	}
	313
	314	1;
	315
	316	__END__;
	317
ec75fdb0	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
3890b670	521
ec75fdb0	522	This library is free software; you can redistribute it and/or modify it under
ec75fdb0	523	the same terms as Perl itself.
3890b670	524
ec75fdb0	525	=cut