lib/MooseX/MetaDescription/Meta/Trait.pm

   1 package MooseX::MetaDescription::Meta::Trait;
   2 use Moose::Role;
   3
   4 our $VERSION   = '0.03';
   5 our $AUTHORITY = 'cpan:STEVAN';
   6
   7 has 'description' => (
   8     is      => 'ro',
   9     isa     => 'HashRef',
  10     lazy    => 1,
  11     default => sub { +{} },
  12 );
  13
  14 has 'metadescription_classname' => (
  15     is      => 'rw',
  16     isa     => 'Str',
  17     lazy    => 1,
  18     default => sub {
  19         'MooseX::MetaDescription::Description'
  20     }
  21 );
  22
  23 has 'metadescription' => (
  24     is      => 'ro',
  25     isa     => 'MooseX::MetaDescription::Description',
  26     lazy    => 1,
  27     default => sub {
  28         my $self = shift;
  29
  30         my $metadesc_class = $self->metadescription_classname;
  31         my $desc           = $self->description;
  32
  33         Class::MOP::load_class($metadesc_class);
  34
  35         if (my $traits = delete $desc->{traits}) {
  36             my $meta = Moose::Meta::Class->create_anon_class(
  37                 superclasses => [ $metadesc_class ],
  38                 roles        => $self->prepare_traits_for_application($traits),
  39             );
  40             $meta->add_method('meta' => sub { $meta });
  41             $metadesc_class = $meta->name;
  42         }
  43
  44         return $metadesc_class->new(%$desc, descriptor => $self);
  45     },
  46 );
  47
  48 # this is for the subclasses to use ...
  49 sub prepare_traits_for_application { $_[1] }
  50
  51 no Moose::Role; 1;
  52
  53 __END__
  54
  55 =pod
  56
  57 =head1 NAME
  58
  59 MooseX::MetaDescription::Meta::Trait - Custom class meta-trait for meta-descriptions
  60
  61 =head1 SYNOPSIS
  62
  63   package Foo;
  64   use Moose;
  65
  66   has 'baz' => (
  67       # apply this as a trait to your attribute
  68       traits      => [ 'MooseX::MetaDescription::Meta::Trait' ],
  69       is          => 'ro',
  70       isa         => 'Str',
  71       default     => sub { 'Foo::baz' },
  72       description => {
  73           bar   => 'Foo::baz::bar',
  74           gorch => 'Foo::baz::gorch',
  75       }
  76   );
  77
  78 =head1 DESCRIPTION
  79
  80 This is the core of the Meta Description functionality, it is a role that is done
  81 by both L<MooseX::MetaDescription::Meta::Attribute> and L<MooseX::MetaDescription::Meta::Class>
  82 and can be used on it's own as a meta-attribute trait.
  83
  84 =head1 METHODS
  85
  86 =over 4
  87
  88 =item B<description>
  89
  90 The description C<HASH> ref is stored here.
  91
  92 =item B<metadescription_classname>
  93
  94 This provides the name of the metadescription class, currently this
  95 defaults to L<MooseX::MetaDescription::Description>. It is read only
  96 and so can only be specified at instance construction time.
  97
  98 =item B<metadescription>
  99
 100 This is the instance of the class specified in C<metadescription_classname>
 101 it is generated lazily and is also read-only. In general you will never
 102 need to set this yourself, but simply set C<metadescription_classname>
 103 and it will all just work.
 104
 105 =item B<prepare_traits_for_application ($traits)>
 106
 107 This is passed the ARRAY ref of trait names so that they can be pre-processed
 108 before they are applied to the metadescription. It is expected to return
 109 an ARRAY ref of trait names to be applied. By default it simply returns what
 110 it is given.
 111
 112 =item B<meta>
 113
 114 The L<Moose::Role> metaclass.
 115
 116 =back
 117
 118 =head1 BUGS
 119
 120 All complex software has bugs lurking in it, and this module is no
 121 exception. If you find a bug please either email me, or add the bug
 122 to cpan-RT.
 123
 124 =head1 AUTHOR
 125
 126 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
 127
 128 =head1 COPYRIGHT AND LICENSE
 129
 130 Copyright 2008 Infinity Interactive, Inc.
 131
 132 L<http://www.iinteractive.com>
 133
 134 This library is free software; you can redistribute it and/or modify
 135 it under the same terms as Perl itself.
 136
 137 =cut