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 delete : method {
  53     my ($attr, $reader, $writer) = @_;
  54     return sub { delete $reader->($_[0])->{$_[1]} };
  55 }
  56
  57 1;
  58
  59 __END__
  60
  61 =pod
  62
  63 =head1 NAME
  64
  65 MooseX::AttributeHelpers::MethodProvider::Hash
  66
  67 =head1 DESCRIPTION
  68
  69 This is a role which provides the method generators for
  70 L<MooseX::AttributeHelpers::Collection::Hash>.
  71
  72 =head1 METHODS
  73
  74 =over 4
  75
  76 =item B<meta>
  77
  78 =back
  79
  80 =head1 PROVIDED METHODS
  81
  82 =over 4
  83
  84 =item B<count>
  85
  86 =item B<delete>
  87
  88 =item B<empty>
  89
  90 =item B<exists>
  91
  92 =item B<get>
  93
  94 =item B<keys>
  95
  96 =item B<set>
  97
  98 =item B<values>
  99
 100 =back
 101
 102 =head1 BUGS
 103
 104 All complex software has bugs lurking in it, and this module is no
 105 exception. If you find a bug please either email me, or add the bug
 106 to cpan-RT.
 107
 108 =head1 AUTHOR
 109
 110 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 111
 112 =head1 COPYRIGHT AND LICENSE
 113
 114 Copyright 2007 by Infinity Interactive, Inc.
 115
 116 L<http://www.iinteractive.com>
 117
 118 This library is free software; you can redistribute it and/or modify
 119 it under the same terms as Perl itself.
 120
 121 =cut
 122