lib/MooseX/AttributeHelpers/MethodProvider/ImmutableHash.pm

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