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 );
  21
  22 before 'process_options_for_provides' => sub {
  23     my ($self, $options) = @_;
  24
  25     if (exists $options->{isa}) {
  26         my $type = $options->{isa};
  27
  28         # ... we should check if the type exists already
  29         # and then we should use it,.. however, this means
  30         # we need to extract the container type constraint
  31         # as well, which is a little trickier
  32
  33         if ($type =~ /^(.*)\[(.*)\]$/) {
  34             my $core_type      = $1;
  35             my $container_type = $2;
  36
  37             $options->{container_type} = $container_type;
  38
  39             my $container_type_constraint = find_type_constraint($container_type);
  40
  41             # NOTE:
  42             # I am not sure DWIM-ery is a good thing
  43             # here, so i am going to err on the side
  44             # of caution, and blow up if you have
  45             # not made a type constraint for this yet.
  46             # - SL
  47             (defined $container_type_constraint)
  48                 || confess "You must predefine the '$container_type' constraint before you can use it as a container type";
  49
  50             $options->{container_type_constraint} = $container_type_constraint;
  51
  52             if ($core_type eq 'ArrayRef') {
  53                 $options->{isa} = subtype('ArrayRef' => where {
  54                     foreach my $x (@$_) { ($container_type_constraint->check($x)) || return } 1;
  55                 });
  56             }
  57             elsif ($core_type eq 'HashRef') {
  58                 $options->{isa} = subtype('HashRef' => where {
  59                     foreach my $x (values %$_) { ($container_type_constraint->check($x)) || return } 1;
  60                 });
  61             }
  62             else {
  63                 confess "Your isa must be either ArrayRef or HashRef (sorry no subtype support yet)";
  64             }
  65         }
  66     }
  67 };
  68
  69 no Moose;
  70 no Moose::Util::TypeConstraints;
  71
  72 1;
  73
  74 __END__
  75
  76 =pod
  77
  78 =head1 NAME
  79
  80 MooseX::AttributeHelpers::Collection - Base class for all collection type helpers
  81
  82 =head1 DESCRIPTION
  83
  84 Documentation to come.
  85
  86 =head1 METHODS
  87
  88 =over 4
  89
  90 =item B<container_type>
  91
  92 =item B<container_type_constraint>
  93
  94 =item B<has_container_type>
  95
  96 =item B<process_options_for_provides>
  97
  98 =back
  99
 100 =head1 BUGS
 101
 102 All complex software has bugs lurking in it, and this module is no
 103 exception. If you find a bug please either email me, or add the bug
 104 to cpan-RT.
 105
 106 =head1 AUTHOR
 107
 108 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 109
 110 =head1 COPYRIGHT AND LICENSE
 111
 112 Copyright 2007 by Infinity Interactive, Inc.
 113
 114 L<http://www.iinteractive.com>
 115
 116 This library is free software; you can redistribute it and/or modify
 117 it under the same terms as Perl itself.
 118
 119 =cut