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   472 use 5.006; # our, pragma
  6         13  
2 6     6   36 use strict;
  6         7  
  6         97  
3 6     6   18 use warnings;
  6         5  
  6         303  
4              
5             package MooseX::AttributeIndexes::Provider::FromAttributes;
6              
7             our $VERSION = '2.000001';
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   386 use Moose::Role;
  6         299520  
  6         31  
14 6     6   20115 use Scalar::Util qw( blessed reftype );
  6         8  
  6         296  
15 6     6   622 use namespace::clean -except => 'meta';
  6         4664  
  6         35  
16              
17              
18              
19              
20              
21              
22              
23              
24              
25              
26              
27              
28              
29             sub attribute_indexes {
30              
31 5     5 1 10658 my $self = shift;
32 5         21 my $meta = $self->meta();
33              
34 5         70 my $k = {};
35              
36 5         28 for my $attr_name ( $meta->get_attribute_list ) {
37 9         53 my $attr = $meta->get_attribute($attr_name);
38              
39 9 50       66 if ( $attr->does('MooseX::AttributeIndexes::Meta::Attribute::Trait::Indexed') ) {
40 9         2982 my $indexed = $attr->primary_index;
41 9   100     238 $indexed ||= $attr->indexed;
42 9         11 my $result;
43 9 100       14 if ($indexed) {
44 7         30 $result = $attr->get_value($self);
45             }
46 9 100 66     714 if ( not blessed($indexed)
      66        
47             and defined reftype($indexed)
48             and 'CODE' eq reftype($indexed) )
49             {
50 2         4 local $_ = $result;
51 2         9 $result = $attr->$indexed( $self, $result );
52             }
53 9 100       25 if ($result) {
54 7         21 $k->{$attr_name} = $result;
55             }
56             }
57             }
58 5         37 return $k;
59             }
60              
61 6     6   2230 no Moose::Role;
  6         8  
  6         22  
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.000001
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) 2017 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