lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm

   1 package MooseX::AttributeHelpers::MethodProvider::Hash;
   2 use Moose::Role;
   3
   4 our $VERSION   = '0.03';
   5 our $AUTHORITY = 'cpan:STEVAN';
   6
   7 with 'MooseX::AttributeHelpers::MethodProvider::ImmutableHash';
   8
   9 sub set : method {
  10     my ($attr, $reader, $writer) = @_;
  11     if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
  12         my $container_type_constraint = $attr->type_constraint->type_parameter;
  13         return sub {
  14             ($container_type_constraint->check($_[2]))
  15                 || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint";
  16             $reader->($_[0])->{$_[1]} = $_[2]
  17         };
  18     }
  19     else {
  20         return sub { $reader->($_[0])->{$_[1]} = $_[2] };
  21     }
  22 }
  23
  24 sub clear : method {
  25     my ($attr, $reader, $writer) = @_;
  26     return sub { %{$reader->($_[0])} = () };
  27 }
  28
  29 sub delete : method {
  30     my ($attr, $reader, $writer) = @_;
  31     return sub { CORE::delete $reader->($_[0])->{$_[1]} };
  32 }
  33
  34 1;
  35
  36 __END__
  37
  38 =pod
  39
  40 =head1 NAME
  41
  42 MooseX::AttributeHelpers::MethodProvider::Hash
  43
  44 =head1 DESCRIPTION
  45
  46 This is a role which provides the method generators for
  47 L<MooseX::AttributeHelpers::Collection::Hash>.
  48
  49 This role is composed from the
  50 L<MooseX::AttributeHelpers::Collection::ImmutableHash> role.
  51
  52 =head1 METHODS
  53
  54 =over 4
  55
  56 =item B<meta>
  57
  58 =back
  59
  60 =head1 PROVIDED METHODS
  61
  62 =over 4
  63
  64 =item B<count>
  65
  66 =item B<delete>
  67
  68 =item B<empty>
  69
  70 =item B<clear>
  71
  72 =item B<exists>
  73
  74 =item B<get>
  75
  76 =item B<keys>
  77
  78 =item B<set>
  79
  80 =item B<values>
  81
  82 =item B<kv>
  83
  84 =back
  85
  86 =head1 BUGS
  87
  88 All complex software has bugs lurking in it, and this module is no
  89 exception. If you find a bug please either email me, or add the bug
  90 to cpan-RT.
  91
  92 =head1 AUTHOR
  93
  94 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  95
  96 =head1 COPYRIGHT AND LICENSE
  97
  98 Copyright 2007 by Infinity Interactive, Inc.
  99
 100 L<http://www.iinteractive.com>
 101
 102 This library is free software; you can redistribute it and/or modify
 103 it under the same terms as Perl itself.
 104
 105 =cut
 106