File Coverage

blib/lib/MooseX/Traits/Util.pm
Criterion Covered Total %
statement 43 44 97.7
branch 14 16 87.5
condition n/a
subroutine 9 9 100.0
pod 0 4 0.0
total 66 73 90.4


line stmt bran cond sub pod time code
1             package MooseX::Traits::Util;
2 7     7   36 use strict;
  7         15  
  7         186  
3 7     7   41 use warnings;
  7         14  
  7         379  
4              
5             our $VERSION = '0.13';
6              
7 7         85 use Sub::Exporter -setup => {
8             exports => ['new_class_with_traits'],
9 7     7   35 };
  7         13  
10              
11 7     7   2382 use Class::Load ();
  7         13  
  7         115  
12 7     7   37 use Carp ();
  7         13  
  7         2914  
13              
14             # note: "$class" throughout is "class name" or "instance of class
15             # name"
16              
17             sub check_class {
18 74     74 0 106 my $class = shift;
19              
20 74 50       293 Carp::confess "We can't interact with traits for a class ($class) ".
21             "that does not do MooseX::Traits" unless $class->does('MooseX::Traits');
22             }
23              
24             sub transform_trait {
25 26     26 0 156 my ($class, $name) = @_;
26 26 100       98 return $1 if $name =~ /^[+](.+)$/;
27              
28 24         57 check_class($class);
29              
30 24         4146 my $namespace = $class->meta->find_attribute_by_name('_trait_namespace');
31 24         1107 my $base;
32 24 100       95 if($namespace->has_default){
33 6         52 $base = $namespace->default;
34 6 50       61 if(ref $base eq 'CODE'){
35 0         0 $base = $base->();
36             }
37             }
38              
39 24 100       145 return $name unless $base;
40 6         20 return join '::', $base, $name;
41             }
42              
43             sub resolve_traits {
44 25     25 0 57 my ($class, @traits) = @_;
45              
46 25         58 check_class($class);
47              
48             return map {
49 25         4303 my $orig = $_;
  30         52  
50 30 100       70 if(!ref $orig){
51 26         70 my $transformed = transform_trait($class, $orig);
52 26         109 Class::Load::load_class($transformed);
53 26         874 $transformed;
54             }
55             else {
56 4         13 $orig;
57             }
58             } @traits;
59             }
60              
61             my $anon_serial = 0;
62              
63             sub new_class_with_traits {
64 25     25 0 9454 my ($class, @traits) = @_;
65              
66 25         72 check_class($class);
67              
68 23         4507 my $meta;
69 23         75 @traits = resolve_traits($class, @traits);
70 23 100       73 if (@traits) {
71 18         90 $meta = $class->meta->create(
72             join(q{::} => 'MooseX::Traits::__ANON__::SERIAL', ++$anon_serial),
73             superclasses => [ $class->meta->name ],
74             roles => \@traits,
75             cache => 1,
76             );
77             }
78              
79             # if no traits were given just return the class meta
80 23 100       149132 return $meta ? $meta : $class->meta;
81             }
82              
83             1;
84              
85             =for Pod::Coverage check_class new_class_with_traits resolve_traits transform_trait
86              
87             =cut