File Coverage

blib/lib/MooseX/Attribute/Dependent/Meta/Role/Attribute.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             #
2             # This file is part of MooseX-Attribute-Dependent
3             #
4             # This software is Copyright (c) 2011 by Moritz Onken.
5             #
6             # This is free software, licensed under:
7             #
8             # The (three-clause) BSD License
9             #
10             package MooseX::Attribute::Dependent::Meta::Role::Attribute;
11             {
12             $MooseX::Attribute::Dependent::Meta::Role::Attribute::VERSION = '1.1.2';
13             }
14 3     3   38628 use strict;
  3         7  
  3         116  
15 3     3   15 use warnings;
  3         7  
  3         96  
16 3     3   17 use Moose::Role;
  3         8  
  3         27  
17              
18             has dependency => ( predicate => 'has_dependency', is => 'ro' );
19              
20             before initialize_instance_slot => sub {
21             my ( $self, $meta_instance, $instance, $params ) = @_;
22             return
23             unless ( exists $params->{ $self->init_arg }
24             && ( my $dep = $self->dependency ) );
25             $self->throw_error( $dep->get_message, object => $instance )
26             unless (
27             $dep->constraint->( $self->init_arg, $params, @{ $dep->parameters } ) );
28             };
29              
30             around accessor_metaclass => sub {
31             my ($orig) = (shift);
32             my $class = shift->$orig(@_);
33             return Moose::Meta::Class->create_anon_class(
34             superclasses => [$class],
35             roles => ['MooseX::Attribute::Dependent::Meta::Role::Method::Accessor'],
36             cache => 1
37             )->name;
38            
39             } if Moose->VERSION < 1.9900;
40              
41             around _inline_check_required => sub {
42             my $orig = shift;
43             my $attr = shift;
44             my @code = $attr->$orig(@_);
45             return @code
46             if ( !$attr->does('MooseX::Attribute::Dependent::Meta::Role::Attribute')
47             || !$attr->has_dependency
48             || !$attr->init_arg );
49             my @source;
50             my $related =
51             "'" . join( "', '", @{ $attr->dependency->parameters } ) . "'";
52             push @source => $attr->_inline_throw_error(
53             '"' . quotemeta( $attr->dependency->get_message ) . '"' );
54             push @source => "unless("
55             . $attr->dependency->name
56             . "->constraint->(\""
57             . quotemeta( $attr->name )
58             . "\", \$_[0], $related));";
59              
60             return join( "\n", @source, @code );
61             } if Moose->VERSION >= 1.9900;
62              
63             1;
64             __END__
65             =pod
66              
67             =head1 NAME
68              
69             MooseX::Attribute::Dependent::Meta::Role::Attribute
70              
71             =head1 VERSION
72              
73             version 1.1.2
74              
75             =head1 AUTHOR
76              
77             Moritz Onken
78              
79             =head1 COPYRIGHT AND LICENSE
80              
81             This software is Copyright (c) 2011 by Moritz Onken.
82              
83             This is free software, licensed under:
84              
85             The (three-clause) BSD License
86              
87             =cut
88