File Coverage

blib/lib/MooseX/Traits/Util.pm
Criterion Covered Total %
statement 44 45 97.7
branch 14 16 87.5
condition n/a
subroutine 10 10 100.0
pod 0 4 0.0
total 68 75 90.6


line stmt bran cond sub pod time code
1             package MooseX::Traits::Util;
2             {
3             $MooseX::Traits::Util::VERSION = '0.12';
4             }
5             BEGIN {
6 6     6   2348 $MooseX::Traits::Util::AUTHORITY = 'cpan:JROCKWAY';
7             }
8 6     6   47 use strict;
  6         22  
  6         217  
9 6     6   34 use warnings;
  6         11  
  6         270  
10              
11 6         84 use Sub::Exporter -setup => {
12             exports => ['new_class_with_traits'],
13 6     6   34 };
  6         13  
14              
15 6     6   2603 use Class::Load qw(load_class);
  6         13  
  6         365  
16 6     6   34 use Carp qw(confess);
  6         21  
  6         4344  
17              
18             # note: "$class" throughout is "class name" or "instance of class
19             # name"
20              
21             sub check_class {
22 74     74 0 128 my $class = shift;
23              
24 74 50       349 confess "We can't interact with traits for a class ($class) ".
25             "that does not do MooseX::Traits" unless $class->does('MooseX::Traits');
26             }
27              
28             sub transform_trait {
29 26     26 0 50 my ($class, $name) = @_;
30 26 100       113 return $1 if $name =~ /^[+](.+)$/;
31              
32 24         100 check_class($class);
33              
34 24         10446 my $namespace = $class->meta->find_attribute_by_name('_trait_namespace');
35 24         1591 my $base;
36 24 100       130 if($namespace->has_default){
37 6         117 $base = $namespace->default;
38 6 50       57 if(ref $base eq 'CODE'){
39 0         0 $base = $base->();
40             }
41             }
42              
43 24 100       181 return $name unless $base;
44 6         23 return join '::', $base, $name;
45             }
46              
47             sub resolve_traits {
48 25     25 0 71 my ($class, @traits) = @_;
49              
50 25         171 check_class($class);
51              
52 30         61 return map {
53 25         8248 my $orig = $_;
54 30 100       84 if(!ref $orig){
55 26         173 my $transformed = transform_trait($class, $orig);
56 26         126 load_class($transformed);
57 26         1214 $transformed;
58             }
59             else {
60 4         16 $orig;
61             }
62             } @traits;
63             }
64              
65             my $anon_serial = 0;
66              
67             sub new_class_with_traits {
68 25     25 0 11535 my ($class, @traits) = @_;
69              
70 25         88 check_class($class);
71              
72 23         6298 my $meta;
73 23         108 @traits = resolve_traits($class, @traits);
74 23 100       88 if (@traits) {
75 18         74 $meta = $class->meta->create(
76             join(q{::} => 'MooseX::Traits::__ANON__::SERIAL', ++$anon_serial),
77             superclasses => [ $class->meta->name ],
78             roles => \@traits,
79             cache => 1,
80             );
81             }
82              
83             # if no traits were given just return the class meta
84 23 100       228544 return $meta ? $meta : $class->meta;
85             }
86              
87             1;
88              
89             =for Pod::Coverage check_class new_class_with_traits resolve_traits transform_trait
90              
91             =cut