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 82     82   1151 use strict;
  82         161  
  82         1782  
4 82     82   317 use warnings;
  82         136  
  82         1457  
5 82     82   324 use Perl::PrereqScanner::NotQuiteLite::Util;
  82         145  
  82         38009  
6              
7             sub register { return {
8 81     81 0 374 use => {
9             'Syntax::Collector' => 'parse_syntax_collector_args',
10             },
11             }}
12              
13             sub parse_syntax_collector_args {
14 3     3 0 8 my ($class, $c, $used_module, $raw_tokens) = @_;
15              
16 3         10 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         31 my $spec;
23 3 100       10 if (!(@$tokens % 2)) {
24 2         9 while(my ($key, $value) = splice @$tokens, 0, 2) {
25 1 50       5 my $keystr = ref $key ? $key->[0] : $key;
26 1 50       4 if ($keystr eq '-collect') {
27 1         2 $spec = $value;
28 1         107 last;
29             }
30             }
31             } else {
32 1         2 $spec = $tokens->[0];
33             }
34 3 50       15 if (ref $spec) {
35 0         0 $spec = $spec->[0];
36             }
37 3 100       9 return unless $spec;
38              
39             my @features =
40             map {
41 6 100       245 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         28 grep { m/[A-Z0-9]/i } # at least one alphanum
55 16         38 map { s/(^\s+)|(\s+$)//; $_ } # trim
  16         26  
56 2         5 map { split /(\r?\n|\r)/ } # split lines
  2         33  
57             $spec;
58              
59 2         7 for my $feature (@features) {
60 6         102 $c->add($feature->[1], $feature->[2]);
61             }
62             }
63              
64             1;
65              
66             __END__