File Coverage

blib/lib/MooseX/AttributeIndexes/Provider/FromAttributes.pm
Criterion Covered Total %
statement 37 37 100.0
branch 7 8 87.5
condition 7 9 77.7
subroutine 8 8 100.0
pod 1 1 100.0
total 60 63 95.2


line stmt bran cond sub pod time code
1 6     6   897 use 5.006; # our, pragma
  6         21  
2 6     6   47 use strict;
  6         9  
  6         156  
3 6     6   29 use warnings;
  6         9  
  6         412  
4              
5             package MooseX::AttributeIndexes::Provider::FromAttributes;
6              
7             our $VERSION = '2.000000';
8              
9             # ABSTRACT: A Glue-on-role that provides attribute_indexes data to a class via harvesting attribute traits
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13 6     6   454 use Moose::Role;
  6         337607  
  6         41  
14 6     6   23690 use Scalar::Util qw( blessed reftype );
  6         7  
  6         331  
15 6     6   581 use namespace::clean -except => 'meta';
  6         4473  
  6         37  
16              
17              
18              
19              
20              
21              
22              
23              
24              
25              
26              
27              
28              
29             sub attribute_indexes {
30              
31 5     5 1 13457 my $self = shift;
32 5         22 my $meta = $self->meta();
33              
34 5         68 my $k = {};
35              
36 5         33 for my $attr_name ( $meta->get_attribute_list ) {
37 9         58 my $attr = $meta->get_attribute($attr_name);
38              
39 9 50       66 if ( $attr->does('MooseX::AttributeIndexes::Meta::Attribute::Trait::Indexed') ) {
40 9         2971 my $indexed = $attr->primary_index;
41 9   100     265 $indexed ||= $attr->indexed;
42 9         9 my $result;
43 9 100       18 if ($indexed) {
44 7         36 $result = $attr->get_value($self);
45             }
46 9 100 66     758 if ( not blessed($indexed)
      66        
47             and defined reftype($indexed)
48             and 'CODE' eq reftype($indexed) )
49             {
50 2         3 local $_ = $result;
51 2         9 $result = $attr->$indexed( $self, $result );
52             }
53 9 100       24 if ($result) {
54 7         17 $k->{$attr_name} = $result;
55             }
56             }
57             }
58 5         30 return $k;
59             }
60              
61 6     6   2340 no Moose::Role;
  6         7  
  6         24  
62              
63             1;
64              
65             __END__
66              
67             =pod
68              
69             =encoding UTF-8
70              
71             =head1 NAME
72              
73             MooseX::AttributeIndexes::Provider::FromAttributes - A Glue-on-role that provides attribute_indexes data to a class via harvesting attribute traits
74              
75             =head1 VERSION
76              
77             version 2.000000
78              
79             =head1 METHODS
80              
81             =head2 C<attribute_indexes>
82              
83             A very trivial scanner, which looks for the
84              
85             C<indexed> and C<primary_index> keys and returns a hashref of
86              
87             key->value pairs ( circumventing the getter )
88              
89             =head1 AUTHORS
90              
91             =over 4
92              
93             =item *
94              
95             Kent Fredric <kentnl@cpan.org>
96              
97             =item *
98              
99             Jesse Luehrs <doy@cpan.org>
100              
101             =back
102              
103             =head1 COPYRIGHT AND LICENSE
104              
105             This software is copyright (c) 2014 by Kent Fredric <kentfredric@gmail.com>.
106              
107             This is free software; you can redistribute it and/or modify it under
108             the same terms as the Perl 5 programming language system itself.
109              
110             =cut