lib/MooseX/MetaDescription/Meta/Trait.pm

   1 package MooseX::MetaDescription::Meta::Trait;
   2 use Moose::Role;
   3
   4 our $VERSION   = '0.01';
   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      => 'ro',
  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         if (my $traits = delete $desc->{traits}) {
  34             my $meta = Moose::Meta::Class->create_anon_class(
  35                 superclasses => [ $metadesc_class ],
  36                 roles        => $traits,
  37             );
  38             $meta->add_method('meta' => sub { $meta });
  39             $metadesc_class = $meta->name;
  40         }
  41
  42         return $metadesc_class->new(%$desc, descriptor => $self);
  43     },
  44 );
  45
  46 no Moose::Role; 1;
  47
  48 __END__
  49
  50 =pod
  51
  52 =head1 NAME
  53
  54 MooseX::MetaDescription::Meta::Trait - Custom class meta-trait for meta-descriptions
  55
  56 =head1 DESCRIPTION
  57
  58 Nothing worth saying yet actually, mostly internal usage only. See the
  59 SYNPOSIS in L<MooseX::MetaDescription> for an example of usage.
  60
  61 =head1 METHODS
  62
  63 =over 4
  64
  65 =item B<description>
  66
  67 =item B<metadescription_classname>
  68
  69 =item B<metadescription>
  70
  71 =back
  72
  73 =head1 BUGS
  74
  75 All complex software has bugs lurking in it, and this module is no
  76 exception. If you find a bug please either email me, or add the bug
  77 to cpan-RT.
  78
  79 =head1 AUTHOR
  80
  81 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
  82
  83 =head1 COPYRIGHT AND LICENSE
  84
  85 Copyright 2008 Infinity Interactive, Inc.
  86
  87 L<http://www.iinteractive.com>
  88
  89 This library is free software; you can redistribute it and/or modify
  90 it under the same terms as Perl itself.
  91
  92 =cut