1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
package Perl::PrereqScanner::NotQuiteLite::Util;
use strict;
use warnings;
use Exporter 5.57 qw/import/;
our %FLAGS; BEGIN {
my $i = 0;
%FLAGS = map {$_ => 1 << $i++} qw/
F_KEEP_TOKENS
F_EVAL
F_STRING_EVAL
F_EXPECTS_BRACKET
F_CONDITIONAL
F_SIDEFF
F_SCOPE_END
F_STATEMENT_END
F_EXPR_END
F_EXPR
/;
}
use constant \%FLAGS;
use constant {
MASK_KEEP_TOKENS => ~(F_KEEP_TOKENS),
MASK_EXPR_END => ~(F_EXPR_END|F_EXPR),
MASK_STATEMENT_END => ~(F_KEEP_TOKENS|F_STATEMENT_END|F_EXPR|F_EXPR_END|F_SIDEFF),
MASK_EVAL => ~(F_EVAL),
MASK_SIDEFF => ~(F_SIDEFF),
F_RESCAN => (F_KEEP_TOKENS|F_EVAL|F_STRING_EVAL|F_CONDITIONAL),
};
our @EXPORT = ((keys %FLAGS), qw/
is_module_name
is_version
convert_string_tokens
convert_string_token_list
MASK_KEEP_TOKENS
MASK_EXPR_END
MASK_STATEMENT_END
MASK_EVAL
MASK_SIDEFF
F_RESCAN
/);
sub is_module_name {
my $name = shift or return;
return 1 if $name =~ /^[A-Za-z_][A-Za-z0-9_]*(?:(?:::|')[A-Za-z0-9_]+)*$/;
return;
}
sub is_version {
my $version = shift;
return unless defined $version;
return 1 if $version =~ /\A
(
[0-9]+(?:\.[0-9]+)?
|
v[0-9]+(?:\.[0-9]+)*
|
[0-9]+(?:\.[0-9]+){2,}
) (?:_[0-9]+)?
\z/x;
return;
}
sub convert_string_tokens {
my $org_tokens = shift;
my @tokens;
my @copied_tokens = @$org_tokens;
my $prev = '';
while(my $copied_token = shift @copied_tokens) {
my ($token, $desc) = @$copied_token;
if ($desc and $desc eq '()' and $prev ne 'WORD') {
unshift @copied_tokens, @$token;
next;
}
if (!$desc) {
push @tokens, $copied_token;
} elsif ($desc eq 'VERSION_STRING' or $desc eq 'NUMBER') {
push @tokens, $token;
} elsif ($desc eq 'STRING') {
push @tokens, $token->[0];
} elsif ($desc eq 'QUOTED_WORD_LIST') {
push @tokens, grep {defined $_ and $_ ne ''} split /\s/, $token->[0];
} else {
push @tokens, $copied_token;
}
$prev = $desc;
}
\@tokens;
}
sub convert_string_token_list {
my $org_tokens = shift;
my @list;
my @tokens;
my @copied_tokens = @$org_tokens;
my $prev = '';
while(my $copied_token = shift @copied_tokens) {
my ($token, $desc) = @$copied_token;
if ($desc and $desc eq '()' and $prev ne 'WORD') {
unshift @copied_tokens, @$token;
next;
}
if (!$desc) {
push @tokens, $copied_token;
} elsif ($desc eq 'VERSION_STRING' or $desc eq 'NUMBER') {
push @tokens, $token;
} elsif ($desc eq 'STRING') {
push @tokens, $token->[0];
} elsif ($desc eq 'QUOTED_WORD_LIST') {
push @list, grep {defined $_ and $_ ne ''} split /\s/, $token->[0];
} elsif ($token eq ',' or $token eq '=>') {
push @list, @tokens == 1 ? $tokens[0] : \@tokens;
@tokens = ();
$prev = '';
} elsif ($desc eq ';') {
last;
} else {
push @tokens, $copied_token;
}
$prev = $desc;
}
if (@tokens) {
push @list, @tokens == 1 ? $tokens[0] : \@tokens;
}
\@list;
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Util
=head1 DESCRIPTION
This provides a few utility functions for internal use.
=head1 FUNCTIONS
=head2 is_module_name
takes a string and returns true if it looks like a module.
=head2 is_version
takes a string and returns true if it looks like a version.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
