lib/MooseX/AttributeHelpers/Collection.pm

   1
   2 package MooseX::AttributeHelpers::Collection;
   3 use Moose;
   4 use Moose::Util::TypeConstraints;
   5
   6 our $VERSION   = '0.01';
   7 our $AUTHORITY = 'cpan:STEVAN';
   8
   9 extends 'MooseX::AttributeHelpers::Base';
  10
  11 has 'container_type' => (
  12     is        => 'ro',
  13     isa       => 'Str',
  14     predicate => 'has_container_type',
  15 );
  16
  17 has 'container_type_constraint' => (
  18     is      => 'rw',
  19     isa     => 'Moose::Meta::TypeConstraint',
  20     lazy    => 1,
  21     default => sub {
  22         my $self = shift;
  23         ($self->has_container_type)
  24             || confess "You cannot create a container_type_constraint if you dont have a container type";
  25
  26         my $container_type = $self->container_type;
  27         my $constraint     = find_type_constraint($container_type);
  28
  29             $constraint = subtype('Object', where { $_->isa($container_type) })
  30                 unless $constraint;
  31
  32         return $constraint;
  33     }
  34 );
  35
  36 before 'process_options_for_provides' => sub {
  37     my ($self, $options) = @_;
  38
  39     if (exists $options->{isa}) {
  40         my $type = $options->{isa};
  41         if ($type =~ /^(.*)\[(.*)\]$/) {
  42             my $core_type      = $1;
  43             my $container_type = $2;
  44             $options->{isa}            = $core_type;
  45             $options->{container_type} = $container_type;
  46         }
  47     }
  48 };
  49
  50 no Moose;
  51
  52 1;
  53
  54 __END__
  55
  56 =pod
  57
  58 =head1 NAME
  59
  60 =head1 SYNOPSIS
  61
  62 =head1 DESCRIPTION
  63
  64 =head1 METHODS
  65
  66 =head1 BUGS
  67
  68 All complex software has bugs lurking in it, and this module is no
  69 exception. If you find a bug please either email me, or add the bug
  70 to cpan-RT.
  71
  72 =head1 AUTHOR
  73
  74 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  75
  76 =head1 COPYRIGHT AND LICENSE
  77
  78 Copyright 2007 by Infinity Interactive, Inc.
  79
  80 L<http://www.iinteractive.com>
  81
  82 This library is free software; you can redistribute it and/or modify
  83 it under the same terms as Perl itself.
  84
  85 =cut