lib/MooseX/AttributeHelpers/MethodProvider/ImmutableHash.pm

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