File Coverage

blib/lib/Salvation/TC/Parser.pm
Criterion Covered Total %
statement 44 58 75.8
branch 8 18 44.4
condition 2 6 33.3
subroutine 11 13 84.6
pod 0 7 0.0
total 65 102 63.7


line stmt bran cond sub pod time code
1             package Salvation::TC::Parser;
2              
3 4     4   13 use strict;
  4         5  
  4         141  
4 4     4   13 use warnings;
  4         4  
  4         93  
5              
6 4     4   13 use Module::Load ();
  4         1  
  4         34  
7 4     4   9 use Class::Inspector ();
  4         3  
  4         608  
8              
9             our $VERSION = 0.06;
10             our $BACKEND;
11              
12             {
13             my $loaded;
14              
15             sub detect {
16              
17 4     4 0 15 $_[ 0 ] -> load_backend();
18 4 50       10 return $BACKEND if defined $BACKEND;
19              
20 4 50       5 if( eval { require Salvation::TC::Parser::XS; 1 } ) {
  4         1243  
  0         0  
21              
22 0         0 $BACKEND = 'Salvation::TC::Parser::XS';
23 0         0 $loaded = 1;
24              
25             } else {
26              
27 4         9 $BACKEND = 'Salvation::TC::Parser::PP';
28             }
29              
30 4         69 $_[ 0 ] -> load_backend();
31 4         5 return $BACKEND;
32             }
33              
34             sub load_backend {
35              
36 8 100   8 0 23 return unless defined $BACKEND;
37              
38 4 50       13 unless( $loaded ) {
39              
40 4         6 $loaded = 1;
41              
42 4         36 Module::Load::load( $BACKEND );
43             }
44              
45 4         35 return;
46             }
47             }
48              
49             {
50             my $code;
51              
52             sub tokenize_type_str {
53              
54 137 100   137 0 453 goto $code if defined $code;
55              
56 4         14 $_[ 0 ] -> detect();
57 4         10 my $name = "${BACKEND}::tokenize_type_str_impl";
58              
59 4     4   14 no strict 'refs';
  4         3  
  4         293  
60              
61 4         22 goto $code = *$name{ 'CODE' };
62             }
63             }
64              
65             {
66             my $code;
67              
68             sub tokenize_signature_str {
69              
70 0 0   0 0 0 goto $code if defined $code;
71              
72 0         0 $_[ 0 ] -> detect();
73 0         0 my $name = "${BACKEND}::tokenize_signature_str_impl";
74              
75 4     4   13 no strict 'refs';
  4         2  
  4         740  
76              
77 0         0 goto $code = *$name{ 'CODE' };
78             }
79             }
80              
81             sub parameterizable_type_class_ns {
82              
83 51     51 0 59 return 'Salvation::TC::Meta::Type::Parameterized';
84             }
85              
86             {
87             my $re = qr/^Salvation::TC::Type::(.+?)$/;
88              
89             sub look_for_type_short_name {
90              
91 0     0 0 0 my ( $self, $full_name ) = @_;
92              
93 0         0 return ( $full_name =~ $re )[ 0 ];
94             }
95             }
96              
97             sub load_parameterizable_type_class {
98              
99 51     51 0 54 my ( $self, $word ) = @_;
100              
101 51         89 my $ns = $self -> parameterizable_type_class_ns();
102 51         75 my $class = "${ns}::${word}";
103 51         47 my $parameterizable_type = '';
104              
105 51 50 66     151 if(
    0          
106             Class::Inspector -> loaded( $class )
107 8         548 || eval{ Module::Load::load( $class ); 1 }
  8         90  
108             ) {
109              
110 51         951 $parameterizable_type = $class;
111              
112             } elsif( defined( $word = $self -> look_for_type_short_name( $word ) ) ) {
113              
114 0         0 $class = "${ns}::${word}";
115              
116 0 0 0     0 if(
117             Class::Inspector -> loaded( $class )
118 0         0 || eval{ Module::Load::load( $class ); 1 }
  0         0  
119             ) {
120              
121 0         0 $parameterizable_type = $class;
122             }
123             }
124              
125 51         98 return $parameterizable_type;
126             }
127              
128             1;
129              
130             __END__