File Coverage

lib/Perl/PrereqScanner/NotQuiteLite/Parser/SyntaxCollector.pm
Criterion Covered Total %
statement 32 34 94.1
branch 11 16 68.7
condition n/a
subroutine 5 5 100.0
pod 0 2 0.0
total 48 57 84.2


line stmt bran cond sub pod time code
1             package Perl::PrereqScanner::NotQuiteLite::Parser::SyntaxCollector;
2              
3 83     83   1686 use strict;
  83         212  
  83         2262  
4 83     83   409 use warnings;
  83         184  
  83         1854  
5 83     83   429 use Perl::PrereqScanner::NotQuiteLite::Util;
  83         180  
  83         45884  
6              
7             sub register { return {
8 82     82 0 480 use => {
9             'Syntax::Collector' => 'parse_syntax_collector_args',
10             },
11             }}
12              
13             sub parse_syntax_collector_args {
14 3     3 0 7 my ($class, $c, $used_module, $raw_tokens) = @_;
15              
16 3         9 my $tokens = convert_string_token_list($raw_tokens);
17              
18 3 50       10 if (is_version($tokens->[0])) {
19 0         0 $c->add($used_module => shift @$tokens);
20             }
21              
22 3         6 my $spec;
23 3 100       9 if (!(@$tokens % 2)) {
24 2         9 while(my ($key, $value) = splice @$tokens, 0, 2) {
25 1 50       4 my $keystr = ref $key ? $key->[0] : $key;
26 1 50       3 if ($keystr eq '-collect') {
27 1         2 $spec = $value;
28 1         78 last;
29             }
30             }
31             } else {
32 1         2 $spec = $tokens->[0];
33             }
34 3 50       7 if (ref $spec) {
35 0         0 $spec = $spec->[0];
36             }
37 3 100       8 return unless $spec;
38              
39             my @features =
40             map {
41 6 100       248 m{^
    50          
42             (use|no) \s+ # "use" or "no"
43             (\S+) \s+ # module name
44             ([\d\._v]+) # module version
45             (?: # everything else
46             \s* (.+)
47             )? # ... perhaps
48             [;] \s* # semicolon
49             $}x
50             ? [$1, $2, $3, [ defined($4) ? eval "($4)" : ()] ]
51             : die("Line q{$_} doesn't conform to 'use MODULE VERSION [ARGS];'")
52             }
53 6         11 grep { ! m/^#/ } # not a comment
54 16         36 grep { m/[A-Z0-9]/i } # at least one alphanum
55 16         39 map { s/(^\s+)|(\s+$)//; $_ } # trim
  16         26  
56 2         4 map { split /(\r?\n|\r)/ } # split lines
  2         39  
57             $spec;
58              
59 2         8 for my $feature (@features) {
60 6         116 $c->add($feature->[1], $feature->[2]);
61             }
62             }
63              
64             1;
65              
66             __END__