lib/MooseX/AttributeHelpers/MethodProvider/Hash.pm

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