MooseX::AttributeIndexes::Provider::FromAttributes - A Glue-on-role that provides attribute_indexes data to a class via harvesting attribute traits

MooseX-AttributeIndexes documentation Contained in the MooseX-AttributeIndexes distribution.

Index

Code Index:

NAME

Top

MooseX::AttributeIndexes::Provider::FromAttributes - A Glue-on-role that provides attribute_indexes data to a class via harvesting attribute traits

VERSION

Top

version 1.0.1

METHODS

Top

attribute_indexes

A very trivial scanner, which looks for the

indexed and primary_index keys and returns a hashref of

key->value pairs ( circumventing the getter )

AUTHORS

Top

COPYRIGHT AND LICENSE

Top

This software is copyright (c) 2011 by Kent Fredric.

This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.

MooseX-AttributeIndexes documentation Contained in the MooseX-AttributeIndexes distribution. 
use strict;
use warnings;
package MooseX::AttributeIndexes::Provider::FromAttributes;
BEGIN {
  $MooseX::AttributeIndexes::Provider::FromAttributes::VERSION = '1.0.1';
}

# ABSTRACT: A Glue-on-role that provides attribute_indexes data to a class via harvesting attribute traits

# $Id:$
use Moose::Role;
use Scalar::Util qw( blessed reftype );
use namespace::autoclean;


sub attribute_indexes {

  my $self = shift;
  my $meta = $self->meta();

  my $k = {};

  for my $attr_name ( $meta->get_attribute_list ){
    my $attr = $meta->get_attribute( $attr_name );

    if( $attr->does( 'MooseX::AttributeIndexes::Meta::Attribute::Trait::Indexed' ) ) {
      my $indexed = $attr->primary_index;
      $indexed ||= $attr->indexed;
      my $result;
      if( $indexed ){
        $result = $attr->get_value($self);
      }
      if( not blessed($indexed) and defined reftype( $indexed ) and reftype( $indexed ) eq 'CODE' ){
        local $_ = $result;
        $result = $attr->$indexed( $self, $result );
      }
      if ( $result ){
        $k->{$attr_name} = $result;
      }
    }
  }
  return $k;
}
1;


__END__