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
|
package PlSense::ModuleBuilder::DocBuilder;
use parent qw{ PlSense::ModuleBuilder };
use strict;
use warnings;
use Class::Std;
use PlSense::Logger;
use PlSense::Configure;
{
sub build {
my ($self, $mdl) = @_;
my $mdlnm = $mdl->get_name();
if ( $mdlnm eq "main" ) { return; }
my $filepath = $mdl->get_filepath;
my $perldoc = get_config("perldoc");
my $mdlhelptext = qx{ $perldoc -t $mdlnm 2>/dev/null } || qx{ $perldoc -t '$filepath' 2>/dev/null };
if ( $mdlhelptext ne '' ) {
$mdl->set_helptext($mdlhelptext);
}
else {
logger->info("Can't get document of [$mdlnm] in [$filepath]");
return;
}
my @cands = ($mdl->keys_member, $mdl->keys_method);
my @indents = (4, 2, 0);
my $remained = 1;
BUILD:
while ( $remained ) {
$remained = 0;
my $indent = pop @indents;
if ( ! defined $indent ) { last BUILD; }
$self->build_from_indent_matched($mdl, $mdlhelptext, $indent);
CAND:
foreach my $cand ( @cands ) {
my $c = $mdl->exist_member($cand) ? $mdl->get_member($cand) : $mdl->get_method($cand);
if ( $c->get_helptext() eq "" ) {
$remained = 1;
last CAND;
}
}
}
}
sub build_from_indent_matched : PRIVATE {
my ($self, $mdl, $text, $indent) = @_;
my @cands = ($mdl->keys_member(), $mdl->keys_method());
my ($helptext, $lasttitle);
my @curre;
TITLE:
while ( $text =~ m{ ^ \s{$indent} ([^\s] [^\n]+) $ }xms ) {
($text, $helptext) = ($', $`);
my $title = $1;
if ( $self->update_helptext($lasttitle, $helptext, $indent, @curre) ) {
@curre = ();
$lasttitle = "";
}
my $c;
CAND:
foreach my $cand ( @cands ) {
my $regexp = quotemeta($cand);
if ( $title =~ m{ \A $regexp (\s|$) }xms ||
$title =~ m{ \A " $regexp " (\s|$) }xms ||
$title =~ m{ \A ' $regexp ' (\s|$) }xms ) {
$c = $mdl->exist_member($cand) ? $mdl->get_member($cand) : $mdl->get_method($cand) and last CAND;
}
}
if ( $c ) {
push @curre, $c;
$lasttitle .= $title."\n";
}
else {
@curre = ();
$lasttitle = "";
}
}
$self->update_helptext($lasttitle, $helptext, $indent, @curre);
}
sub update_helptext : PRIVATE {
my ($self, $title, $text, $indent, @idents) = @_;
if ( $#idents < 0 || ! $title || ! $text || $text !~ m{ [^\s] }xms ) { return; }
my $validhelp;
my $helptext = $title;
LINE:
foreach my $line ( split m{ \n }xms, $text ) {
if ( $line =~ m{ [^\s] }xms && $line !~ s{ \A \s{$indent} }{}xms ) { last LINE; }
$helptext .= $line."\n";
$validhelp = 1;
}
if ( ! $validhelp ) { return; }
ADD_HELPTEXT:
foreach my $e ( @idents ) {
if ( ! $e || ! $e->isa("PlSense::Symbol") ) { next ADD_HELPTEXT; }
$e->set_helptext($e->get_helptext."\n===== Part of PerlDoc =====\n".$helptext);
logger->info("Updated help of [".$e->get_fullnm."]");
}
return 1;
}
}
1;
__END__
|
