line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perinci::Gen::ForModule; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $DATE = '2016-06-14'; # DATE |
4
|
|
|
|
|
|
|
our $VERSION = '0.09'; # VERSION |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
14494
|
use 5.010001; |
|
1
|
|
|
|
|
2
|
|
7
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
18
|
|
8
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
28
|
|
9
|
1
|
|
|
1
|
|
948
|
use Log::Any::IfLOG '$log'; |
|
1
|
|
|
|
|
13
|
|
|
1
|
|
|
|
|
6
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
723
|
use SHARYANTO::Array::Util qw(match_array_or_regex); |
|
1
|
|
|
|
|
12306
|
|
|
1
|
|
|
|
|
102
|
|
12
|
1
|
|
|
1
|
|
611
|
use Package::MoreUtil qw(package_exists list_package_contents); |
|
1
|
|
|
|
|
907
|
|
|
1
|
|
|
|
|
78
|
|
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
6
|
use Exporter qw(import); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
295
|
|
15
|
|
|
|
|
|
|
our @EXPORT_OK = qw(gen_meta_for_module); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our %SPEC; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
$SPEC{gen_meta_for_module} = { |
20
|
|
|
|
|
|
|
v => 1.1, |
21
|
|
|
|
|
|
|
summary => 'Generate metadata for a module', |
22
|
|
|
|
|
|
|
description => <<'_', |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
This function can be used to automatically generate Rinci metadata for a |
25
|
|
|
|
|
|
|
"traditional" Perl module which do not have any. Currently, only a plain and |
26
|
|
|
|
|
|
|
generic package and function metadata are generated. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
The resulting metadata will be put in %::SPEC. Functions that already |
29
|
|
|
|
|
|
|
have metadata in the %SPEC will be skipped. The metadata will have |
30
|
|
|
|
|
|
|
C property set to true, C set to C, and C |
31
|
|
|
|
|
|
|
set to C<{args => ["any" => {schema=>'any', pos=>0, greedy=>1}]}>. In the |
32
|
|
|
|
|
|
|
future, function's arguments (and other properties) will be parsed from POD (and |
33
|
|
|
|
|
|
|
other indicators). |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
_ |
36
|
|
|
|
|
|
|
args => { |
37
|
|
|
|
|
|
|
module => { |
38
|
|
|
|
|
|
|
schema => 'str*', |
39
|
|
|
|
|
|
|
summary => 'The module name', |
40
|
|
|
|
|
|
|
}, |
41
|
|
|
|
|
|
|
load => { |
42
|
|
|
|
|
|
|
schema => ['bool*' => {default=>1}], |
43
|
|
|
|
|
|
|
summary => 'Whether to load the module using require()', |
44
|
|
|
|
|
|
|
}, |
45
|
|
|
|
|
|
|
include_subs => { |
46
|
|
|
|
|
|
|
schema => ['any' => { # XXX or regex |
47
|
|
|
|
|
|
|
of => [['array*'=>{of=>'str*'}], 'str*'], # 2nd should be regex* |
48
|
|
|
|
|
|
|
}], |
49
|
|
|
|
|
|
|
summary => 'If specified, only include these subs', |
50
|
|
|
|
|
|
|
}, |
51
|
|
|
|
|
|
|
exclude_subs => { |
52
|
|
|
|
|
|
|
schema => ['any' => { # XXX or regex |
53
|
|
|
|
|
|
|
of => [['array*'=>{of=>'str*'}], 'str*'], # 2nd should be regex* |
54
|
|
|
|
|
|
|
default => '^_', |
55
|
|
|
|
|
|
|
}], |
56
|
|
|
|
|
|
|
summary => 'If specified, exclude these subs', |
57
|
|
|
|
|
|
|
description => <<'_', |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
By default, exclude private subroutines (subroutines which have _ prefix in |
60
|
|
|
|
|
|
|
their names). |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
_ |
63
|
|
|
|
|
|
|
}, |
64
|
|
|
|
|
|
|
}, |
65
|
|
|
|
|
|
|
}; |
66
|
|
|
|
|
|
|
sub gen_meta_for_module { |
67
|
1
|
|
|
1
|
1
|
7
|
my %args = @_; |
68
|
|
|
|
|
|
|
|
69
|
1
|
|
|
|
|
2
|
my $inc = $args{include_subs}; |
70
|
1
|
|
33
|
|
|
10
|
my $exc = $args{exclude_subs} // qr/^_/; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# XXX schema |
73
|
|
|
|
|
|
|
my $module = $args{module} |
74
|
1
|
50
|
|
|
|
3
|
or return [400, "Please specify module"]; |
75
|
1
|
|
50
|
|
|
6
|
my $load = $args{load} // 1; |
76
|
|
|
|
|
|
|
|
77
|
1
|
50
|
|
|
|
3
|
if ($load) { |
78
|
1
|
|
|
|
|
2
|
eval { |
79
|
1
|
|
|
|
|
1
|
my $modulep = $module; $modulep =~ s!::!/!g; |
|
1
|
|
|
|
|
4
|
|
80
|
1
|
|
|
|
|
222
|
require "$modulep.pm"; |
81
|
|
|
|
|
|
|
}; |
82
|
1
|
|
|
|
|
4
|
my $eval_err = $@; |
83
|
|
|
|
|
|
|
#return [500, "Can't load module $module: $eval_err"] if $eval_err; |
84
|
|
|
|
|
|
|
# ignore the error and try to load it anyway |
85
|
|
|
|
|
|
|
} |
86
|
1
|
50
|
|
|
|
5
|
return [500, "Package $module does not exist"] |
87
|
|
|
|
|
|
|
unless package_exists($module); |
88
|
|
|
|
|
|
|
|
89
|
1
|
|
|
|
|
21
|
my $note; |
90
|
|
|
|
|
|
|
{ |
91
|
1
|
|
|
1
|
|
8
|
no strict 'vars'; # for $VERSION |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
78
|
|
|
1
|
|
|
|
|
1
|
|
92
|
1
|
|
50
|
|
|
89
|
$note = "This metadata is automatically generated by ". |
93
|
|
|
|
|
|
|
__PACKAGE__." version ".($VERSION//"?")." on ".localtime(); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
1
|
|
|
|
|
2
|
my $metas; |
97
|
|
|
|
|
|
|
{ |
98
|
1
|
|
|
1
|
|
6
|
no strict 'refs'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
400
|
|
|
1
|
|
|
|
|
1
|
|
99
|
1
|
|
|
|
|
2
|
$metas = \%{"$module\::SPEC"}; |
|
1
|
|
|
|
|
4
|
|
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
1
|
50
|
|
|
|
5
|
if (keys %$metas) { |
103
|
0
|
|
|
|
|
0
|
$log->info("Not creating metadata for package $module: ". |
104
|
|
|
|
|
|
|
"already defined"); |
105
|
0
|
|
|
|
|
0
|
return [304, "Not modified"]; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# generate package metadata |
109
|
1
|
|
|
|
|
4
|
$metas->{":package"} = { |
110
|
|
|
|
|
|
|
v => 1.1, |
111
|
|
|
|
|
|
|
summary => $module, |
112
|
|
|
|
|
|
|
description => $note, |
113
|
|
|
|
|
|
|
}; |
114
|
|
|
|
|
|
|
|
115
|
1
|
|
|
|
|
4
|
my %content = list_package_contents($module); |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# generate subroutine metadatas |
118
|
1
|
|
|
|
|
83
|
for my $sub (sort grep {ref($content{$_}) eq 'CODE'} keys %content) { |
|
4
|
|
|
|
|
12
|
|
119
|
3
|
|
|
|
|
17
|
$log->tracef("Adding meta for subroutine %s ...", $sub); |
120
|
3
|
50
|
33
|
|
|
30
|
if (defined($inc) && !match_array_or_regex($sub, $inc)) { |
121
|
0
|
|
|
|
|
0
|
$log->info("Not creating metadata for sub $module\::$sub: ". |
122
|
|
|
|
|
|
|
"doesn't match include_subs"); |
123
|
0
|
|
|
|
|
0
|
next; |
124
|
|
|
|
|
|
|
} |
125
|
3
|
100
|
66
|
|
|
10
|
if (defined($exc) && match_array_or_regex($sub, $exc)) { |
126
|
1
|
|
|
|
|
20
|
$log->info("Not creating metadata for sub $module\::$sub: ". |
127
|
|
|
|
|
|
|
"matches exclude_subs"); |
128
|
1
|
|
|
|
|
2
|
next; |
129
|
|
|
|
|
|
|
} |
130
|
2
|
50
|
|
|
|
18
|
if ($metas->{$sub}) { |
131
|
0
|
|
|
|
|
0
|
$log->info("Not creating metadata for sub $module\::$sub: ". |
132
|
|
|
|
|
|
|
"already defined"); |
133
|
0
|
|
|
|
|
0
|
next; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
2
|
|
|
|
|
11
|
my $meta = { |
137
|
|
|
|
|
|
|
v => 1.1, |
138
|
|
|
|
|
|
|
summary => $sub, |
139
|
|
|
|
|
|
|
description => $note, |
140
|
|
|
|
|
|
|
result_naked => 1, |
141
|
|
|
|
|
|
|
args_as => 'array', |
142
|
|
|
|
|
|
|
args => { |
143
|
|
|
|
|
|
|
args => { |
144
|
|
|
|
|
|
|
schema => ['array*' => {of=>'any'}], |
145
|
|
|
|
|
|
|
summary => 'Arguments', |
146
|
|
|
|
|
|
|
pos => 0, |
147
|
|
|
|
|
|
|
greedy => 1, |
148
|
|
|
|
|
|
|
}, |
149
|
|
|
|
|
|
|
}, |
150
|
|
|
|
|
|
|
}; |
151
|
2
|
|
|
|
|
3
|
$metas->{$sub} = $meta; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
1
|
|
|
|
|
5
|
[200, "OK", $metas]; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
1; |
158
|
|
|
|
|
|
|
# ABSTRACT: Generate metadata for a module |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
__END__ |