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
|
package Perl::PrereqScanner::NotQuiteLite::Parser::ObjectPad;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
'Object::Pad' => 'parse_object_pad_args',
},
}}
sub parse_object_pad_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->register_sub_parser(
'class',
[$class, 'parse_class_args', $used_module],
);
$c->register_sub_parser(
'role',
[$class, 'parse_role_args', $used_module],
);
$c->register_keyword_parser(
'class',
[$class, 'parse_class_args', $used_module],
);
$c->register_keyword_parser(
'role',
[$class, 'parse_role_args', $used_module],
);
$c->register_sub_keywords(qw/
class method role
/);
$c->prototype_re(qr{\G(\((?:[^\\\(\)]*(?:\\.[^\\\(\)]*)*)\))});
}
sub parse_class_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard class
my $isa = my $does = 0;
while(my $token = shift @$tokens) {
my ($name, $version) = ('', 0);
if (ref $token && $token->[1] && $token->[1] eq 'WORD') {
if ($token->[0] eq 'isa' or $token->[0] eq 'extends') {
$isa = 1;
$does = 0;
next;
}
if ($token->[0] eq 'does' or $token->[0] eq 'implements') {
$isa = 0;
$does = 1;
next;
}
if (is_module_name($token->[0])) {
$name = $token->[0];
if (@$tokens && is_version($tokens->[0])) {
$version = shift @$tokens;
}
if ($isa or $does) {
$c->add($name => $version);
} else {
$c->add_package($name => $version);
}
}
}
if (ref $token && $token->[1] && $token->[1] eq 'ATTRIBUTE') {
while($token->[0] =~ s/:(?:isa|does)\(([^)]+)\)//) {
my ($name, $version) = split /\s+/, $1;
$version ||= 0;
if (is_module_name($name) && is_version($version)) {
$c->add($name => $version);
}
}
}
}
}
sub parse_role_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard role
while(my $token = shift @$tokens) {
my ($name, $version) = ('', 0);
if (is_module_name($token->[0])) {
$name = $token->[0];
if (@$tokens && is_version($tokens->[0])) {
$version = shift @$tokens;
}
$c->add_package($name => $version);
}
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::ObjectPad
=head1 DESCRIPTION
This parser is to deal with modules loaded by C<isa/extends> and/or
C<does> from L<Object::Pad>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2021 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
|
