lib/MooseX/AttributeHelpers/MethodProvider/ImmutableHash.pm

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