line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package Pod::POM::Web; |
3
|
|
|
|
|
|
|
|
4
|
1
|
|
|
1
|
|
123580
|
use strict; |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
31
|
|
5
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
32
|
|
6
|
1
|
|
|
1
|
|
27
|
use 5.008; |
|
1
|
|
|
|
|
6
|
|
7
|
1
|
|
|
1
|
|
6
|
no warnings 'uninitialized'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
57
|
|
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
695
|
use Pod::POM 0.25; |
|
1
|
|
|
|
|
25027
|
|
|
1
|
|
|
|
|
74
|
|
10
|
1
|
|
|
1
|
|
13
|
use List::Util qw/max/; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
211
|
|
11
|
1
|
|
|
1
|
|
812
|
use List::MoreUtils qw/uniq firstval any/; |
|
1
|
|
|
|
|
14419
|
|
|
1
|
|
|
|
|
9
|
|
12
|
1
|
|
|
1
|
|
4735
|
use Module::CoreList; |
|
1
|
|
|
|
|
114082
|
|
|
1
|
|
|
|
|
20
|
|
13
|
1
|
|
|
1
|
|
1866
|
use HTTP::Daemon; |
|
1
|
|
|
|
|
74462
|
|
|
1
|
|
|
|
|
19
|
|
14
|
1
|
|
|
1
|
|
648
|
use URI; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
15
|
1
|
|
|
1
|
|
639
|
use URI::QueryParam; |
|
1
|
|
|
|
|
984
|
|
|
1
|
|
|
|
|
39
|
|
16
|
1
|
|
|
1
|
|
578
|
use MIME::Types; |
|
1
|
|
|
|
|
4670
|
|
|
1
|
|
|
|
|
76
|
|
17
|
1
|
|
|
1
|
|
689
|
use Alien::GvaScript 1.021000; |
|
1
|
|
|
|
|
3698
|
|
|
1
|
|
|
|
|
39
|
|
18
|
1
|
|
|
1
|
|
10
|
use Config; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
55
|
|
19
|
1
|
|
|
1
|
|
921
|
use Getopt::Long qw/GetOptions/; |
|
1
|
|
|
|
|
11115
|
|
|
1
|
|
|
|
|
7
|
|
20
|
1
|
|
|
1
|
|
259
|
use Module::Metadata 1.000033; |
|
1
|
|
|
|
|
29
|
|
|
1
|
|
|
|
|
31
|
|
21
|
1
|
|
|
1
|
|
785
|
use Encode qw/decode encode_utf8/; |
|
1
|
|
|
|
|
17519
|
|
|
1
|
|
|
|
|
121
|
|
22
|
1
|
|
|
1
|
|
567
|
use Encode::Detect; |
|
1
|
|
|
|
|
3787
|
|
|
1
|
|
|
|
|
359
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
our $VERSION = '1.24'; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my @ignore_toc_dirs = qw/auto unicore/; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
my $server_root = eval {Apache2::ServerUtil::server_root()} || ""; |
36
|
|
|
|
|
|
|
our |
37
|
|
|
|
|
|
|
@default_module_dirs = grep {!/^\./ && $_ ne $server_root} @INC; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my @config_script_dirs = qw/sitescriptexp vendorscriptexp scriptdirexp/; |
41
|
|
|
|
|
|
|
my @default_script_dirs = grep {$_} @Config{@config_script_dirs}; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $coloring_package |
45
|
|
|
|
|
|
|
= eval {require PPI::HTML} ? "PPI" |
46
|
|
|
|
|
|
|
: eval {require ActiveState::Scineplex} ? "SCINEPLEX" |
47
|
|
|
|
|
|
|
: ""; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
my $no_indexer = eval {require Pod::POM::Web::Indexer} ? 0 : $@; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
my $has_cpan = 0; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
my @podfilters = ( |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub { $_[0] =~ s/\A\s*// }, |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
our |
67
|
|
|
|
|
|
|
%escape_entity = ('&' => '&', |
68
|
|
|
|
|
|
|
'<' => '<', |
69
|
|
|
|
|
|
|
'>' => '>', |
70
|
|
|
|
|
|
|
'"' => '"'); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub import { |
78
|
1
|
|
|
1
|
|
17
|
my $class = shift; |
79
|
1
|
|
|
|
|
5
|
my ($package, $filename) = caller; |
80
|
|
|
|
|
|
|
|
81
|
1
|
|
|
1
|
|
15
|
no strict 'refs'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
8443
|
|
82
|
0
|
|
|
0
|
|
0
|
*{'main::server'} = sub {$class->server(@_)} |
|
0
|
|
|
|
|
0
|
|
83
|
1
|
50
|
33
|
|
|
26
|
if $package eq 'main' and $filename eq '-e'; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub server { |
91
|
0
|
|
|
0
|
1
|
0
|
my ($class, $port, $options) = @_; |
92
|
|
|
|
|
|
|
|
93
|
0
|
|
0
|
|
|
0
|
$options ||= $class->_options_from_cmd_line; |
94
|
0
|
|
0
|
|
|
0
|
$port ||= $options->{port} || 8080; |
|
|
|
0
|
|
|
|
|
95
|
|
|
|
|
|
|
|
96
|
0
|
0
|
|
|
|
0
|
my $daemon = HTTP::Daemon->new(LocalPort => $port, |
97
|
|
|
|
|
|
|
ReuseAddr => 1) |
98
|
|
|
|
|
|
|
or die "could not start daemon on port $port"; |
99
|
0
|
|
|
|
|
0
|
print STDERR "$class listening for requests at URL: ", $daemon->url, "\n"; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
|
102
|
0
|
|
|
|
|
0
|
while (my $client_connection = $daemon->accept) { |
103
|
0
|
|
|
|
|
0
|
while (my $req = $client_connection->get_request) { |
104
|
0
|
|
|
|
|
0
|
print STDERR "URL : " , $req->url, "\n"; |
105
|
0
|
|
|
|
|
0
|
$client_connection->force_last_request; |
106
|
0
|
|
|
|
|
0
|
my $response = HTTP::Response->new; |
107
|
0
|
|
|
|
|
0
|
$class->handler($req, $response, $options); |
108
|
0
|
|
|
|
|
0
|
$client_connection->send_response($response); |
109
|
|
|
|
|
|
|
} |
110
|
0
|
|
|
|
|
0
|
$client_connection->close; |
111
|
0
|
|
|
|
|
0
|
undef($client_connection); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub _options_from_cmd_line { |
117
|
1
|
|
|
1
|
|
664
|
GetOptions \my %options, |
118
|
|
|
|
|
|
|
'port=i', |
119
|
|
|
|
|
|
|
'page_title|title=s', |
120
|
|
|
|
|
|
|
'module_dirs|mdirs=s@{,}', |
121
|
|
|
|
|
|
|
'script_dirs|sdirs=s@{,}', |
122
|
|
|
|
|
|
|
; |
123
|
|
|
|
|
|
|
|
124
|
1
|
|
|
|
|
442
|
push @{$options{module_dirs}}, @default_module_dirs; |
|
1
|
|
|
|
|
7
|
|
125
|
1
|
|
|
|
|
3
|
push @{$options{script_dirs}}, @default_script_dirs; |
|
1
|
|
|
|
|
5
|
|
126
|
|
|
|
|
|
|
|
127
|
1
|
50
|
0
|
|
|
5
|
$options{port} ||= $ARGV[0] if @ARGV; |
128
|
1
|
|
|
|
|
3
|
return \%options; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub handler : method { |
132
|
10
|
|
|
10
|
1
|
16670
|
my ($class, $request, $response, $options) = @_; |
133
|
|
|
|
|
|
|
|
134
|
10
|
|
|
|
|
41
|
my $handler_obj = $class->new($request, $response, $options); |
135
|
|
|
|
|
|
|
|
136
|
10
|
|
|
|
|
38
|
eval { $handler_obj->dispatch_request(); 1} |
|
10
|
|
|
|
|
3664
|
|
137
|
10
|
50
|
|
|
|
21
|
or do { |
138
|
0
|
|
|
|
|
0
|
my $error = $@; |
139
|
0
|
0
|
|
|
|
0
|
if ($error =~ /No file for '(.*)'/) { |
140
|
0
|
|
|
|
|
0
|
$handler_obj->send_content({content => $handler_obj->_no_such_module($1), |
141
|
|
|
|
|
|
|
code => 403}); |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
else { |
144
|
0
|
|
|
|
|
0
|
$handler_obj->send_content({content => $error, |
145
|
|
|
|
|
|
|
code => 500}); |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
}; |
148
|
|
|
|
|
|
|
|
149
|
10
|
|
|
|
|
103
|
return 0; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub new { |
159
|
10
|
|
|
10
|
0
|
32
|
my ($class, $request, $response, $options) = @_; |
160
|
10
|
|
50
|
|
|
32
|
$options ||= {}; |
161
|
10
|
|
|
|
|
43
|
my $self = {%$options}; |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
|
164
|
10
|
50
|
33
|
|
|
41
|
if (!$no_indexer && $class eq __PACKAGE__) { |
165
|
0
|
|
|
|
|
0
|
$class = "Pod::POM::Web::Indexer"; |
166
|
|
|
|
|
|
|
} |
167
|
10
|
|
|
|
|
32
|
for (ref $request) { |
168
|
|
|
|
|
|
|
|
169
|
10
|
50
|
|
|
|
38
|
/^Apache/ and do { |
170
|
0
|
|
|
|
|
0
|
my $path = $request->path_info; |
171
|
0
|
|
|
|
|
0
|
my $q = URI->new; |
172
|
0
|
|
|
|
|
0
|
$q->query($request->args); |
173
|
0
|
|
|
|
|
0
|
my $params = $q->query_form_hash; |
174
|
0
|
|
|
|
|
0
|
(my $uri = $request->uri) =~ s/$path$//; |
175
|
0
|
|
|
|
|
0
|
$self->{response} = $request; |
176
|
0
|
|
|
|
|
0
|
$self->{root_url} = $uri; |
177
|
0
|
|
|
|
|
0
|
$self->{path} = $path; |
178
|
0
|
|
|
|
|
0
|
$self->{params} = $params; |
179
|
0
|
|
|
|
|
0
|
last; |
180
|
|
|
|
|
|
|
}; |
181
|
|
|
|
|
|
|
|
182
|
10
|
50
|
|
|
|
56
|
/^HTTP/ and do { |
183
|
10
|
|
|
|
|
26
|
$self->{response} = $response; |
184
|
10
|
|
|
|
|
26
|
$self->{root_url} = ""; |
185
|
10
|
|
|
|
|
33
|
$self->{path} = $request->url->path; |
186
|
10
|
|
|
|
|
267
|
$self->{params} = $request->url->query_form_hash; |
187
|
10
|
|
|
|
|
551
|
last; |
188
|
|
|
|
|
|
|
}; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
|
191
|
0
|
|
|
|
|
0
|
my $q = URI->new; |
192
|
0
|
|
|
|
|
0
|
$q->query($ENV{QUERY_STRING}); |
193
|
0
|
|
|
|
|
0
|
my $params = $q->query_form_hash; |
194
|
0
|
|
|
|
|
0
|
$self->{response} = undef; |
195
|
0
|
|
|
|
|
0
|
$self->{root_url} = $ENV{SCRIPT_NAME}; |
196
|
0
|
|
|
|
|
0
|
$self->{path} = $ENV{PATH_INFO}; |
197
|
0
|
|
|
|
|
0
|
$self->{params} = $params; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
10
|
|
|
|
|
29
|
bless $self, $class; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
|
208
|
20
|
|
|
20
|
1
|
37
|
sub module_dirs {@{shift->{module_dirs}}} |
|
20
|
|
|
|
|
149
|
|
209
|
0
|
|
|
0
|
0
|
0
|
sub script_dirs {@{shift->{script_dirs}}} |
|
0
|
|
|
|
|
0
|
|
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
sub dispatch_request { |
212
|
10
|
|
|
10
|
0
|
24
|
my ($self) = @_; |
213
|
10
|
|
|
|
|
31
|
my $path_info = $self->{path}; |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
|
216
|
10
|
50
|
|
|
|
58
|
$path_info =~ m[(\.\.|//|\\|:)] and die "illegal path: $path_info"; |
217
|
|
|
|
|
|
|
|
218
|
10
|
100
|
|
|
|
59
|
$path_info =~ s[^/][] or return $self->index_frameset; |
219
|
9
|
|
|
|
|
27
|
for ($path_info) { |
220
|
9
|
100
|
|
|
|
39
|
/^$/ and return $self->index_frameset; |
221
|
8
|
100
|
|
|
|
37
|
/^index$/ and return $self->index_frameset; |
222
|
7
|
100
|
|
|
|
30
|
/^toc$/ and return $self->main_toc; |
223
|
6
|
100
|
|
|
|
33
|
/^toc\/(.*)$/ and return $self->toc_for($1); |
224
|
5
|
50
|
|
|
|
17
|
/^script\/(.*)$/ and return $self->serve_script($1); |
225
|
5
|
100
|
|
|
|
25
|
/^search$/ and return $self->dispatch_search; |
226
|
3
|
100
|
|
|
|
19
|
/^source\/(.*)$/ and return $self->serve_source($1); |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
|
229
|
2
|
50
|
|
|
|
8
|
/^_dirs$/ and return $self->send_html( |
230
|
|
|
|
|
|
|
join "<br>", "<b>Modules</b>" => $self->module_dirs, |
231
|
|
|
|
|
|
|
"<b>Scripts</b>" => $self->script_dirs, |
232
|
|
|
|
|
|
|
); |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
|
235
|
2
|
100
|
|
|
|
15
|
/\.(\w+)$/ and return $self->serve_file($path_info, $1); |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
|
238
|
1
|
|
|
|
|
6
|
return $self->serve_pod($path_info); |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub index_frameset{ |
244
|
3
|
|
|
3
|
0
|
6
|
my ($self) = @_; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
|
247
|
3
|
|
|
|
|
6
|
my $ini = $self->{params}{open}; |
248
|
3
|
|
50
|
|
|
13
|
my $ini_content = $ini || "perl"; |
249
|
3
|
50
|
|
|
|
8
|
my $ini_toc = $ini ? "toc?open=$ini" : "toc"; |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
|
252
|
3
|
|
50
|
|
|
11
|
my $title = $self->{page_title} || 'Perl documentation'; |
253
|
3
|
|
|
|
|
28
|
$title =~ s/([&<>"])/$escape_entity{$1}/g; |
254
|
|
|
|
|
|
|
|
255
|
3
|
|
|
|
|
21
|
return $self->send_html(<<__EOHTML__); |
256
|
|
|
|
|
|
|
<html> |
257
|
|
|
|
|
|
|
<head><title>$title</title></head> |
258
|
|
|
|
|
|
|
<frameset cols="25%, 75%"> |
259
|
|
|
|
|
|
|
<frame name="tocFrame" src="$self->{root_url}/$ini_toc"> |
260
|
|
|
|
|
|
|
<frame name="contentFrame" src="$self->{root_url}/$ini_content"> |
261
|
|
|
|
|
|
|
</frameset> |
262
|
|
|
|
|
|
|
</html> |
263
|
|
|
|
|
|
|
__EOHTML__ |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub serve_source { |
274
|
1
|
|
|
1
|
0
|
4
|
my ($self, $path) = @_; |
275
|
|
|
|
|
|
|
|
276
|
1
|
|
|
|
|
51
|
my $params = $self->{params}; |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
|
279
|
1
|
50
|
|
|
|
9
|
$params->{print} or $params->{lines} = $params->{coloring} = 1; |
280
|
|
|
|
|
|
|
|
281
|
1
|
50
|
|
|
|
5
|
my @files = $self->find_source($path) or die "No file for '$path'"; |
282
|
1
|
|
|
|
|
3
|
my $mtime = max map {(stat $_)[9]} @files; |
|
1
|
|
|
|
|
22
|
|
283
|
|
|
|
|
|
|
|
284
|
1
|
|
|
|
|
4
|
my $display_text; |
285
|
|
|
|
|
|
|
|
286
|
1
|
|
|
|
|
3
|
foreach my $file (@files) { |
287
|
1
|
|
|
|
|
6
|
my $text = decode("Detect", $self->slurp_file($file, ":raw")); |
288
|
1
|
|
|
|
|
693
|
$text =~ s/\r\n/\n/g; |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
my $view = $self->mk_view( |
291
|
|
|
|
|
|
|
line_numbering => $params->{lines}, |
292
|
1
|
50
|
|
|
|
10
|
syntax_coloring => ($params->{coloring} ? $coloring_package : "") |
293
|
|
|
|
|
|
|
); |
294
|
1
|
|
|
|
|
7
|
$text = $view->view_verbatim($text); |
295
|
1
|
|
|
|
|
119
|
$display_text .= "<p/><h2>$file</h2><p/><pre>$text</pre>"; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
|
299
|
1
|
50
|
|
|
|
9
|
my $offer_print = $params->{print} ? "" : <<__EOHTML__; |
300
|
|
|
|
|
|
|
<form method="get" target="_blank"> |
301
|
|
|
|
|
|
|
<input type="submit" name="print" value="Print"> with<br> |
302
|
|
|
|
|
|
|
<input type="checkbox" name="lines" checked>line numbers<br> |
303
|
|
|
|
|
|
|
<input type="checkbox" name="coloring" checked>syntax coloring |
304
|
|
|
|
|
|
|
</form> |
305
|
|
|
|
|
|
|
__EOHTML__ |
306
|
|
|
|
|
|
|
|
307
|
1
|
50
|
|
|
|
9
|
my $script = $params->{print} ? <<__EOHTML__ : ""; |
308
|
|
|
|
|
|
|
<script> |
309
|
|
|
|
|
|
|
window.onload = function () {window.print()}; |
310
|
|
|
|
|
|
|
</script> |
311
|
|
|
|
|
|
|
__EOHTML__ |
312
|
|
|
|
|
|
|
|
313
|
1
|
50
|
|
|
|
8
|
my $doc_link = $params->{print} ? "" : <<__EOHTML__; |
314
|
|
|
|
|
|
|
<a href="$self->{root_url}/$path" style="float:right">Doc</a> |
315
|
|
|
|
|
|
|
__EOHTML__ |
316
|
|
|
|
|
|
|
|
317
|
1
|
|
|
|
|
110
|
my $html = <<__EOHTML__; |
318
|
|
|
|
|
|
|
<html> |
319
|
|
|
|
|
|
|
<head> |
320
|
|
|
|
|
|
|
<title>Source of $path</title> |
321
|
|
|
|
|
|
|
<link href="$self->{root_url}/Alien/GvaScript/lib/GvaScript.css" rel="stylesheet" type="text/css"> |
322
|
|
|
|
|
|
|
<link href="$self->{root_url}/Pod/POM/Web/lib/PodPomWeb.css" rel="stylesheet" type="text/css"> |
323
|
|
|
|
|
|
|
<style> |
324
|
|
|
|
|
|
|
PRE {border: none; background: none} |
325
|
|
|
|
|
|
|
FORM {float: right; font-size: 70%; border: 1px solid} |
326
|
|
|
|
|
|
|
</style> |
327
|
|
|
|
|
|
|
</head> |
328
|
|
|
|
|
|
|
<body> |
329
|
|
|
|
|
|
|
$doc_link |
330
|
|
|
|
|
|
|
<h1>Source of $path</h1> |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
$offer_print |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
$display_text |
335
|
|
|
|
|
|
|
</body> |
336
|
|
|
|
|
|
|
</html> |
337
|
|
|
|
|
|
|
__EOHTML__ |
338
|
|
|
|
|
|
|
|
339
|
1
|
|
|
|
|
12
|
$self->send_html($html, $mtime); |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub serve_file { |
345
|
1
|
|
|
1
|
0
|
5
|
my ($self, $path, $extension) = @_; |
346
|
|
|
|
|
|
|
|
347
|
1
|
50
|
|
6
|
|
9
|
my $fullpath = firstval {-f $_} map {"$_/$path"} $self->module_dirs |
|
6
|
|
|
|
|
97
|
|
|
8
|
|
|
|
|
28
|
|
348
|
|
|
|
|
|
|
or die "could not find $path"; |
349
|
|
|
|
|
|
|
|
350
|
1
|
|
|
|
|
17
|
my $mime_type = MIME::Types->new->mimeTypeOf($extension); |
351
|
1
|
|
|
|
|
55181
|
my $content = $self->slurp_file($fullpath, ":raw"); |
352
|
1
|
|
|
|
|
22
|
my $mtime = (stat $fullpath)[9]; |
353
|
1
|
|
|
|
|
11
|
$self->send_content({ |
354
|
|
|
|
|
|
|
content => $content, |
355
|
|
|
|
|
|
|
mtime => $mtime, |
356
|
|
|
|
|
|
|
mime_type => $mime_type, |
357
|
|
|
|
|
|
|
}); |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub serve_pod { |
363
|
1
|
|
|
1
|
0
|
4
|
my ($self, $path) = @_; |
364
|
1
|
|
|
|
|
4
|
$path =~ s[::][/]g; |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
|
367
|
1
|
50
|
|
|
|
7
|
my @sources = $self->find_source($path) or die "No file for '$path'"; |
368
|
1
|
|
|
|
|
6
|
my $mtime = max map {(stat $_)[9]} @sources; |
|
1
|
|
|
|
|
23
|
|
369
|
1
|
50
|
|
|
|
10
|
my $content = $path =~ /\bperltoc\b/ |
370
|
|
|
|
|
|
|
? $self->fake_perltoc |
371
|
|
|
|
|
|
|
: $self->slurp_file($sources[0], ":crlf"); |
372
|
|
|
|
|
|
|
|
373
|
1
|
|
|
|
|
9
|
(my $mod_name = $path) =~ s[/][::]g; |
374
|
1
|
50
|
|
|
|
11
|
my $version = @sources > 1 |
375
|
|
|
|
|
|
|
? $self->parse_version($self->slurp_file($sources[-1], ":crlf"), $mod_name) |
376
|
|
|
|
|
|
|
: $self->parse_version($content, $mod_name); |
377
|
|
|
|
|
|
|
|
378
|
1
|
|
|
|
|
29
|
for my $filter (@podfilters) { |
379
|
1
|
|
|
|
|
5
|
$filter->($content); |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
|
383
|
1
|
50
|
|
|
|
6
|
if ($path =~ /\bperlfunc$/) { |
384
|
0
|
|
|
0
|
|
0
|
my $sub = sub {my $txt = shift; $txt =~ s[C<(.*?)>][C<L</$1>>]g; $txt}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
385
|
0
|
|
|
|
|
0
|
$content =~ s[(Perl Functions by Category)(.*?)(Alphabetical Listing)] |
|
0
|
|
|
|
|
0
|
|
386
|
|
|
|
|
|
|
[$1 . $sub->($2) . $3]es; |
387
|
|
|
|
|
|
|
} |
388
|
1
|
|
|
|
|
12
|
|
389
|
1
|
50
|
|
|
|
24
|
my $parser = Pod::POM->new; |
390
|
1
|
|
|
|
|
13380
|
my $pom = $parser->parse_text($content) or die $parser->error; |
391
|
|
|
|
|
|
|
my $view = $self->mk_view(version => $version, |
392
|
|
|
|
|
|
|
mtime => $mtime, |
393
|
|
|
|
|
|
|
path => $path, |
394
|
|
|
|
|
|
|
mod_name => $mod_name, |
395
|
|
|
|
|
|
|
syntax_coloring => $coloring_package); |
396
|
1
|
|
|
|
|
6
|
|
397
|
|
|
|
|
|
|
my $html = $view->print($pom); |
398
|
|
|
|
|
|
|
|
399
|
1
|
50
|
|
|
|
193
|
|
400
|
0
|
|
|
|
|
0
|
if ($path =~ /\bperlfunc$/) { |
401
|
|
|
|
|
|
|
$html =~ s/li id="(.*?)_.*?"/li id="$1"/g; |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
|
404
|
1
|
50
|
|
|
|
5
|
|
405
|
0
|
|
|
0
|
|
0
|
if ($path =~ /\bperl$/) { |
406
|
0
|
|
|
|
|
0
|
my $sub = sub {my $txt = shift; |
407
|
0
|
|
|
|
|
0
|
$txt =~ s[(perl\w+)] |
|
0
|
|
|
|
|
0
|
|
408
|
0
|
|
|
|
|
0
|
[<a href="$self->{root_url}/$1">$1</a>]g; |
|
0
|
|
|
|
|
0
|
|
409
|
|
|
|
|
|
|
return $txt}; |
410
|
|
|
|
|
|
|
$html =~ s[(<pre.*?</pre>)][$sub->($1)]egs; |
411
|
1
|
|
|
|
|
6
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
return $self->send_html($html, $mtime); |
414
|
|
|
|
|
|
|
} |
415
|
0
|
|
|
0
|
0
|
0
|
|
416
|
|
|
|
|
|
|
sub fake_perltoc { |
417
|
0
|
|
|
|
|
0
|
my ($self) = @_; |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
return "=head1 NAME\n\nperltoc\n\n=head1 DESCRIPTION\n\n" |
420
|
|
|
|
|
|
|
. "I<Sorry, this page cannot be displayed in HTML by Pod:POM::Web " |
421
|
|
|
|
|
|
|
. "(too CPU-intensive). " |
422
|
|
|
|
|
|
|
. "If you really need it, please consult the source, using the link " |
423
|
|
|
|
|
|
|
. "in the top-right corner.>"; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
0
|
|
|
0
|
0
|
0
|
|
427
|
|
|
|
|
|
|
sub serve_script { |
428
|
0
|
|
|
|
|
0
|
my ($self, $path) = @_; |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
my $fullpath; |
431
|
0
|
|
|
|
|
0
|
|
432
|
0
|
|
|
|
|
0
|
DIR: |
433
|
0
|
|
|
|
|
0
|
foreach my $dir ($self->script_dirs) { |
434
|
0
|
0
|
|
|
|
0
|
foreach my $ext ("", ".pl", ".bat") { |
435
|
|
|
|
|
|
|
$fullpath = "$dir/$path$ext"; |
436
|
|
|
|
|
|
|
last DIR if -f $fullpath; |
437
|
|
|
|
|
|
|
} |
438
|
0
|
0
|
|
|
|
0
|
} |
439
|
|
|
|
|
|
|
|
440
|
0
|
|
|
|
|
0
|
$fullpath or die "no such script : $path"; |
441
|
0
|
|
|
|
|
0
|
|
442
|
|
|
|
|
|
|
my $content = $self->slurp_file($fullpath, ":crlf"); |
443
|
0
|
|
|
|
|
0
|
my $mtime = (stat $fullpath)[9]; |
444
|
0
|
|
|
|
|
0
|
|
445
|
|
|
|
|
|
|
for my $filter (@podfilters) { |
446
|
|
|
|
|
|
|
$filter->($content); |
447
|
0
|
|
|
|
|
0
|
} |
448
|
0
|
0
|
|
|
|
0
|
|
449
|
0
|
|
|
|
|
0
|
my $parser = Pod::POM->new; |
450
|
|
|
|
|
|
|
my $pom = $parser->parse_text($content) or die $parser->error; |
451
|
|
|
|
|
|
|
my $view = $self->mk_view(path => "scripts/$path", |
452
|
0
|
|
|
|
|
0
|
mtime => $mtime, |
453
|
|
|
|
|
|
|
syntax_coloring => $coloring_package); |
454
|
0
|
|
|
|
|
0
|
my $html = $view->print($pom); |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
return $self->send_html($html, $mtime); |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
16
|
|
|
16
|
0
|
2600
|
|
460
|
|
|
|
|
|
|
sub find_source { |
461
|
|
|
|
|
|
|
my ($self, $path) = @_; |
462
|
16
|
50
|
|
|
|
80
|
|
463
|
|
|
|
|
|
|
|
464
|
0
|
|
|
|
|
0
|
if ($path =~ s[^scripts/][]) { |
465
|
0
|
|
|
|
|
0
|
DIR: |
466
|
0
|
0
|
|
|
|
0
|
foreach my $dir ($self->script_dirs) { |
467
|
0
|
|
|
|
|
0
|
foreach my $ext ("", ".pl", ".bat") { |
468
|
|
|
|
|
|
|
-f "$dir/$path$ext" or next; |
469
|
|
|
|
|
|
|
return ("$dir/$path$ext"); |
470
|
0
|
|
|
|
|
0
|
} |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
return; |
473
|
|
|
|
|
|
|
} |
474
|
16
|
|
|
|
|
66
|
|
475
|
124
|
|
|
|
|
487
|
|
|
496
|
|
|
|
|
7905
|
|
476
|
|
|
|
|
|
|
foreach my $prefix ($self->module_dirs) { |
477
|
|
|
|
|
|
|
my @found = grep {-f} ("$prefix/$path.pod", |
478
|
|
|
|
|
|
|
"$prefix/$path.pm", |
479
|
124
|
100
|
|
|
|
535
|
"$prefix/pod/$path.pod", |
480
|
|
|
|
|
|
|
"$prefix/pods/$path.pod"); |
481
|
0
|
|
|
|
|
0
|
return @found if @found; |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
return; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
11
|
|
|
11
|
0
|
31
|
|
487
|
11
|
|
|
|
|
49
|
sub pod2pom { |
488
|
|
|
|
|
|
|
my ($self, $sourcefile) = @_; |
489
|
11
|
|
|
|
|
88
|
my $content = $self->slurp_file($sourcefile, ":crlf"); |
490
|
11
|
|
|
|
|
123
|
|
491
|
|
|
|
|
|
|
for my $filter (@podfilters) { |
492
|
|
|
|
|
|
|
$filter->($content); |
493
|
11
|
|
|
|
|
145
|
} |
494
|
11
|
50
|
|
|
|
293
|
|
495
|
11
|
|
|
|
|
1435546
|
my $parser = Pod::POM->new; |
496
|
|
|
|
|
|
|
my $pom = $parser->parse_text($content) or die $parser->error; |
497
|
|
|
|
|
|
|
return $pom; |
498
|
|
|
|
|
|
|
} |
499
|
0
|
|
|
0
|
|
0
|
|
500
|
|
|
|
|
|
|
sub _no_such_module { |
501
|
0
|
|
|
|
|
0
|
my ($self, $module) = @_; |
502
|
0
|
|
|
|
|
0
|
|
503
|
0
|
|
|
|
|
0
|
$module =~ s!/!::!g; |
504
|
|
|
|
|
|
|
$module =~ s/([&<>"])/$escape_entity{$1}/g; |
505
|
|
|
|
|
|
|
return <<__EOHTML__; |
506
|
|
|
|
|
|
|
<html> |
507
|
|
|
|
|
|
|
<head> |
508
|
|
|
|
|
|
|
<title>$module not found</title> |
509
|
|
|
|
|
|
|
</head> |
510
|
|
|
|
|
|
|
<body> |
511
|
|
|
|
|
|
|
<h1>$module not found</h1> |
512
|
|
|
|
|
|
|
<p> |
513
|
|
|
|
|
|
|
The module <code>$module</code> could not be found on this server. |
514
|
|
|
|
|
|
|
It may not be installed locally. Please try |
515
|
|
|
|
|
|
|
<a href='https://metacpan.org/pod/$module'>$module on Metacpan</a>. |
516
|
|
|
|
|
|
|
</p> |
517
|
|
|
|
|
|
|
</body> |
518
|
|
|
|
|
|
|
</html> |
519
|
|
|
|
|
|
|
__EOHTML__ |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
|
527
|
1
|
|
|
1
|
0
|
5
|
|
528
|
|
|
|
|
|
|
sub toc_for { |
529
|
|
|
|
|
|
|
my ($self, $prefix) = @_; |
530
|
1
|
|
|
|
|
3
|
|
531
|
1
|
50
|
|
|
|
5
|
|
532
|
1
|
50
|
|
|
|
4
|
for ($prefix) { |
533
|
1
|
50
|
|
|
|
6
|
/^perldocs$/ and return $self->toc_perldocs; |
534
|
|
|
|
|
|
|
/^pragmas$/ and return $self->toc_pragmas; |
535
|
|
|
|
|
|
|
/^scripts$/ and return $self->toc_scripts; |
536
|
|
|
|
|
|
|
} |
537
|
1
|
|
|
|
|
5
|
|
538
|
1
|
50
|
|
|
|
7
|
|
539
|
0
|
|
|
|
|
0
|
my $entries = $self->find_entries_for($prefix); |
540
|
|
|
|
|
|
|
if ($prefix eq 'Pod') { |
541
|
1
|
|
|
|
|
7
|
delete $entries->{$_} for grep /^perl/, keys %$entries; |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
return $self->send_html($self->htmlize_entries($entries)); |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
0
|
|
|
0
|
0
|
0
|
|
547
|
|
|
|
|
|
|
sub toc_perldocs { |
548
|
0
|
|
|
|
|
0
|
my ($self) = @_; |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
my %perldocs; |
551
|
0
|
|
|
|
|
0
|
|
552
|
0
|
|
|
|
|
0
|
|
553
|
|
|
|
|
|
|
for my $subdir (qw/pod pods/, "") { |
554
|
|
|
|
|
|
|
my $entries = $self->find_entries_for($subdir); |
555
|
0
|
|
|
|
|
0
|
|
556
|
0
|
|
|
|
|
0
|
|
557
|
0
|
|
|
|
|
0
|
foreach my $key (grep /^perl/, keys %$entries) { |
558
|
|
|
|
|
|
|
$perldocs{$key} = $entries->{$key}; |
559
|
|
|
|
|
|
|
$perldocs{$key}{node} =~ s[^subdir/][]i; |
560
|
|
|
|
|
|
|
} |
561
|
0
|
|
|
|
|
0
|
} |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
return $self->send_html($self->htmlize_perldocs(\%perldocs)); |
564
|
|
|
|
|
|
|
} |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
|
567
|
0
|
|
|
0
|
0
|
0
|
|
568
|
|
|
|
|
|
|
sub toc_pragmas { |
569
|
0
|
|
|
|
|
0
|
my ($self) = @_; |
570
|
0
|
|
|
|
|
0
|
|
571
|
0
|
0
|
|
|
|
0
|
my $entries = $self->find_entries_for(""); |
|
0
|
|
|
|
|
0
|
|
572
|
|
|
|
|
|
|
delete $entries->{$_} for @ignore_toc_dirs, qw/pod pods inc/; |
573
|
0
|
|
|
|
|
0
|
delete $entries->{$_} for grep {/^perl/ or !/^[[:lower:]]/} keys %$entries; |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
return $self->send_html($self->htmlize_entries($entries)); |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
0
|
|
|
0
|
0
|
0
|
|
579
|
|
|
|
|
|
|
sub toc_scripts { |
580
|
0
|
|
|
|
|
0
|
my ($self) = @_; |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
my %scripts; |
583
|
0
|
|
|
|
|
0
|
|
584
|
0
|
0
|
|
|
|
0
|
|
585
|
|
|
|
|
|
|
foreach my $dir ($self->script_dirs) { |
586
|
0
|
|
|
|
|
0
|
opendir my $dh, $dir or next; |
587
|
0
|
|
|
|
|
0
|
NAME: |
588
|
0
|
0
|
0
|
|
|
0
|
foreach my $name (readdir $dh) { |
|
|
|
0
|
|
|
|
|
589
|
|
|
|
|
|
|
for ("$dir/$name") { |
590
|
0
|
|
|
|
|
0
|
-x && !-d && -T or next NAME ; |
591
|
0
|
|
|
|
|
0
|
} |
592
|
0
|
|
|
|
|
0
|
$name =~ s/\.(pl|bat)$//i; |
593
|
|
|
|
|
|
|
my $letter = uc substr $name, 0, 1; |
594
|
|
|
|
|
|
|
$scripts{$letter}{$name} = {node => "script/$name", pod => 1}; |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
} |
597
|
0
|
|
|
|
|
0
|
|
598
|
0
|
|
|
|
|
0
|
|
599
|
0
|
|
|
|
|
0
|
my $html = ""; |
600
|
0
|
|
|
|
|
0
|
foreach my $letter (sort keys %scripts) { |
601
|
|
|
|
|
|
|
my $content = $self->htmlize_entries($scripts{$letter}); |
602
|
|
|
|
|
|
|
$html .= closed_node(label => $letter, |
603
|
|
|
|
|
|
|
content => $content); |
604
|
0
|
|
|
|
|
0
|
} |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
return $self->send_html($html); |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
|
609
|
1
|
|
|
1
|
0
|
3
|
|
610
|
|
|
|
|
|
|
sub find_entries_for { |
611
|
|
|
|
|
|
|
my ($self, $prefix) = @_; |
612
|
|
|
|
|
|
|
|
613
|
1
|
|
|
|
|
3
|
|
614
|
1
|
50
|
|
|
|
4
|
|
615
|
0
|
|
|
|
|
0
|
my $filter; |
616
|
0
|
|
|
|
|
0
|
if ($prefix =~ /^([A-Z])\*/) { |
617
|
|
|
|
|
|
|
$filter = qr/^$1/; |
618
|
|
|
|
|
|
|
$prefix = ""; |
619
|
1
|
|
|
|
|
2
|
} |
620
|
|
|
|
|
|
|
|
621
|
1
|
|
|
|
|
4
|
my %entries; |
622
|
8
|
50
|
|
|
|
31
|
|
623
|
8
|
100
|
|
|
|
300
|
foreach my $root_dir ($self->module_dirs) { |
624
|
2
|
|
|
|
|
74
|
my $dirname = $prefix ? "$root_dir/$prefix" : $root_dir; |
625
|
15
|
100
|
|
|
|
65
|
opendir my $dh, $dirname or next; |
626
|
11
|
50
|
33
|
|
|
25
|
foreach my $name (readdir $dh) { |
627
|
11
|
|
|
|
|
185
|
next if $name =~ /^\./; |
628
|
11
|
|
|
|
|
76
|
next if $filter and $name !~ $filter; |
629
|
|
|
|
|
|
|
my $is_dir = -d "$dirname/$name"; |
630
|
|
|
|
|
|
|
my $has_pod = $name =~ s/\.(pm|pod)$//; |
631
|
11
|
50
|
66
|
|
|
39
|
|
|
16
|
|
|
|
|
86
|
|
632
|
|
|
|
|
|
|
|
633
|
11
|
50
|
66
|
|
|
41
|
next if $is_dir and grep {m[^\Q$dirname/$name\E]} $self->module_dirs; |
634
|
11
|
50
|
|
|
|
57
|
|
635
|
11
|
100
|
|
|
|
28
|
if ($is_dir || $has_pod) { |
636
|
11
|
100
|
|
|
|
76
|
$entries{$name}{node} = $prefix ? "$prefix/$name" : $name; |
637
|
|
|
|
|
|
|
$entries{$name}{dir} = 1 if $is_dir; |
638
|
|
|
|
|
|
|
$entries{$name}{pod} = 1 if $has_pod; |
639
|
|
|
|
|
|
|
} |
640
|
1
|
|
|
|
|
7
|
} |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
return \%entries; |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
|
645
|
0
|
|
|
0
|
0
|
0
|
|
646
|
0
|
|
|
|
|
0
|
sub htmlize_perldocs { |
647
|
|
|
|
|
|
|
my ($self, $perldocs) = @_; |
648
|
|
|
|
|
|
|
my $parser = Pod::POM->new; |
649
|
0
|
0
|
|
|
|
0
|
|
650
|
|
|
|
|
|
|
|
651
|
0
|
|
|
|
|
0
|
my ($perlpod) = $self->find_source("perl", ":crlf") |
652
|
0
|
0
|
|
|
|
0
|
or die "'perl.pod' does not seem to be installed on this system"; |
653
|
|
|
|
|
|
|
my $source = $self->slurp_file($perlpod); |
654
|
0
|
|
|
0
|
|
0
|
my $perlpom = $parser->parse_text($source) or die $parser->error; |
655
|
0
|
|
0
|
0
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
656
|
0
|
|
|
|
|
0
|
my $h1 = (firstval {$_->title eq 'GETTING HELP'} $perlpom->head1) |
657
|
|
|
|
|
|
|
|| (firstval {$_->title eq 'SYNOPSIS'} $perlpom->head1); |
658
|
|
|
|
|
|
|
my $html = ""; |
659
|
0
|
|
|
|
|
0
|
|
660
|
0
|
|
|
|
|
0
|
|
661
|
0
|
|
|
|
|
0
|
foreach my $h2 ($h1->head2) { |
662
|
|
|
|
|
|
|
my $title = $h2->title; |
663
|
|
|
|
|
|
|
my $content = $h2->verbatim; |
664
|
0
|
|
|
|
|
0
|
|
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
$title =~ s/^Internals.*/Internals/; |
667
|
0
|
|
|
|
|
0
|
|
668
|
0
|
|
|
|
|
0
|
|
669
|
0
|
|
|
|
|
0
|
my @leaves; |
670
|
0
|
0
|
|
|
|
0
|
while ($content =~ /^\s*(perl\S*?)\s*\t(.+)/gm) { |
671
|
|
|
|
|
|
|
my ($ref, $descr) = ($1, $2); |
672
|
|
|
|
|
|
|
my $entry = delete $perldocs->{$ref} or next; |
673
|
0
|
|
|
|
|
0
|
push @leaves, {label => $ref, |
674
|
|
|
|
|
|
|
href => $entry->{node}, |
675
|
|
|
|
|
|
|
attrs => qq{id='$ref' title='$descr'}}; |
676
|
0
|
|
|
|
|
0
|
} |
677
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
678
|
0
|
|
|
|
|
0
|
@leaves = map {leaf(%$_)} |
679
|
|
|
|
|
|
|
sort {$a->{label} cmp $b->{label}} @leaves; |
680
|
|
|
|
|
|
|
$html .= closed_node(label => $title, |
681
|
|
|
|
|
|
|
content => join("\n", @leaves)); |
682
|
|
|
|
|
|
|
} |
683
|
0
|
0
|
|
|
|
0
|
|
684
|
0
|
|
|
|
|
0
|
|
685
|
|
|
|
|
|
|
if (keys %$perldocs) { |
686
|
|
|
|
|
|
|
$html .= closed_node(label => 'Unclassified', |
687
|
|
|
|
|
|
|
content => $self->htmlize_entries($perldocs)); |
688
|
0
|
|
|
|
|
0
|
} |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
return $html; |
691
|
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
|
695
|
1
|
|
|
1
|
0
|
5
|
|
696
|
1
|
|
|
|
|
4
|
sub htmlize_entries { |
697
|
1
|
|
|
|
|
13
|
my ($self, $entries) = @_; |
|
21
|
|
|
|
|
37
|
|
698
|
9
|
|
|
|
|
20
|
my $html = ""; |
699
|
9
|
|
|
|
|
28
|
foreach my $name (sort {uc($a) cmp uc($b)} keys %$entries) { |
700
|
9
|
|
|
|
|
30
|
my $entry = $entries->{$name}; |
701
|
|
|
|
|
|
|
(my $id = $entry->{node}) =~ s[/][::]g; |
702
|
|
|
|
|
|
|
my %args = (class => 'TN_leaf', |
703
|
9
|
100
|
|
|
|
21
|
label => $name, |
704
|
2
|
|
|
|
|
7
|
attrs => qq{id='$id'}); |
705
|
2
|
|
|
|
|
6
|
if ($entry->{dir}) { |
706
|
|
|
|
|
|
|
$args{class} = 'TN_node TN_closed'; |
707
|
9
|
50
|
|
|
|
20
|
$args{attrs} .= qq{ TN:contentURL='toc/$entry->{node}'}; |
708
|
9
|
|
|
|
|
19
|
} |
709
|
9
|
|
|
|
|
19
|
if ($entry->{pod}) { |
710
|
|
|
|
|
|
|
$args{href} = $entry->{node}; |
711
|
9
|
|
|
|
|
23
|
$args{abstract} = $self->get_abstract($entry->{node}); |
712
|
|
|
|
|
|
|
} |
713
|
1
|
|
|
|
|
5
|
$html .= generic_node(%args); |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
return $html; |
716
|
|
|
|
9
|
0
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
sub get_abstract { |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
|
724
|
1
|
|
|
1
|
0
|
3
|
|
725
|
|
|
|
|
|
|
sub main_toc { |
726
|
|
|
|
|
|
|
my ($self) = @_; |
727
|
1
|
|
|
|
|
5
|
|
728
|
1
|
50
|
|
|
|
5
|
|
729
|
|
|
|
|
|
|
my $ini = $self->{params}{open}; |
730
|
|
|
|
|
|
|
my $select_ini = $ini ? "selectToc('$ini');" : ""; |
731
|
1
|
|
|
|
|
6
|
|
|
226
|
|
|
|
|
4405
|
|
|
378
|
|
|
|
|
407976
|
|
732
|
1
|
|
|
|
|
63
|
|
733
|
1
|
|
|
|
|
42027
|
my @funcs = map {$_->title} grep {$_->content =~ /\S/} $self->perlfunc_items; |
|
224
|
|
|
|
|
9608
|
|
734
|
|
|
|
|
|
|
s|[/\s(].*||s foreach @funcs; |
735
|
|
|
|
|
|
|
my $json_funcs = "[" . join(",", map {qq{"$_"}} uniq @funcs) . "]"; |
736
|
1
|
|
|
|
|
56
|
|
|
140
|
|
|
|
|
3469
|
|
|
161
|
|
|
|
|
104175
|
|
|
85
|
|
|
|
|
137
|
|
737
|
1
|
|
|
|
|
43
|
|
738
|
1
|
|
|
|
|
28946
|
my @vars = map {$_->title} grep {!/->/} map {@$_} $self->perlvar_items; |
739
|
1
|
|
|
|
|
2442
|
s|\s*X<.*||s foreach @vars; |
740
|
1
|
|
|
|
|
2212
|
s|\\|\\\\|g foreach @vars; |
|
140
|
|
|
|
|
6974
|
|
741
|
|
|
|
|
|
|
s|"|\\"|g foreach @vars; |
742
|
1
|
50
|
|
|
|
39
|
my $json_vars = "[" . join(",", map {qq{"$_"}} uniq @vars) . "]"; |
743
|
|
|
|
|
|
|
|
744
|
1
|
|
|
|
|
4
|
my $js_no_indexer = $no_indexer ? 'true' : 'false'; |
|
3
|
|
|
|
|
17
|
|
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
my @perl_sections = map {closed_node( |
747
|
|
|
|
|
|
|
label => ucfirst($_), |
748
|
|
|
|
|
|
|
label_class => "TN_label small_title", |
749
|
|
|
|
|
|
|
attrs => qq{TN:contentURL='toc/$_' id='$_'}, |
750
|
1
|
|
|
|
|
4
|
)} qw/perldocs pragmas scripts/; |
751
|
1
|
|
|
|
|
9
|
|
752
|
26
|
|
|
|
|
56
|
my $alpha_list = ""; |
753
|
|
|
|
|
|
|
for my $letter ('A' .. 'Z') { |
754
|
|
|
|
|
|
|
$alpha_list .= closed_node ( |
755
|
|
|
|
|
|
|
label => $letter, |
756
|
|
|
|
|
|
|
label_class => "TN_label", |
757
|
|
|
|
|
|
|
attrs => qq{TN:contentURL='toc/$letter*' id='${letter}:'}, |
758
|
1
|
|
|
|
|
3
|
); |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
my $modules = generic_node (label => "Modules", |
761
|
|
|
|
|
|
|
label_class => "TN_label small_title", |
762
|
|
|
|
|
|
|
content => $alpha_list); |
763
|
1
|
|
|
|
|
91
|
|
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
return $self->send_html(<<__EOHTML__); |
766
|
|
|
|
|
|
|
<html> |
767
|
|
|
|
|
|
|
<head> |
768
|
|
|
|
|
|
|
<base target="contentFrame"> |
769
|
|
|
|
|
|
|
<link href="$self->{root_url}/Alien/GvaScript/lib/GvaScript.css" |
770
|
|
|
|
|
|
|
rel="stylesheet" type="text/css"> |
771
|
|
|
|
|
|
|
<link href="$self->{root_url}/Pod/POM/Web/lib/PodPomWeb.css" |
772
|
|
|
|
|
|
|
rel="stylesheet" type="text/css"> |
773
|
|
|
|
|
|
|
<script src="$self->{root_url}/Alien/GvaScript/lib/prototype.js"></script> |
774
|
|
|
|
|
|
|
<script src="$self->{root_url}/Alien/GvaScript/lib/GvaScript.js"></script> |
775
|
|
|
|
|
|
|
<script> |
776
|
|
|
|
|
|
|
var treeNavigator; |
777
|
|
|
|
|
|
|
var perlfuncs = $json_funcs; |
778
|
|
|
|
|
|
|
var perlvars = $json_vars; |
779
|
|
|
|
|
|
|
var completers = {}; |
780
|
|
|
|
|
|
|
var no_indexer = $js_no_indexer; |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
function submit_on_event(event) { |
783
|
|
|
|
|
|
|
\$('search_form').submit(); |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
function resize_tree_navigator() { |
787
|
|
|
|
|
|
|
// compute available height -- comes either from body or documentElement, |
788
|
|
|
|
|
|
|
// depending on browser and on compatibility mode !! |
789
|
|
|
|
|
|
|
var doc_el_height = document.documentElement.clientHeight; |
790
|
|
|
|
|
|
|
var avail_height |
791
|
|
|
|
|
|
|
= (Prototype.Browser.IE && doc_el_height) ? doc_el_height |
792
|
|
|
|
|
|
|
: document.body.clientHeight; |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
var tree_height = avail_height - \$('toc_frame_top').scrollHeight - 5; |
795
|
|
|
|
|
|
|
if (tree_height > 100) |
796
|
|
|
|
|
|
|
\$('TN_tree').style.height = tree_height + "px"; |
797
|
|
|
|
|
|
|
} |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
function open_nodes(first_node, rest) { |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
var node = \$(first_node); |
802
|
|
|
|
|
|
|
if (!node || !treeNavigator) return; |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
// shift to next node in sequence |
805
|
|
|
|
|
|
|
first_node = rest.shift(); |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
// build a handler for "onAfterLoadContent" (closure on first_node/rest) |
808
|
|
|
|
|
|
|
var open_or_select_next = function() { |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
// delete handler that might have been placed by previous call |
811
|
|
|
|
|
|
|
delete treeNavigator.onAfterLoadContent; |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
// |
814
|
|
|
|
|
|
|
if (rest.length > 0) { |
815
|
|
|
|
|
|
|
open_nodes(first_node, rest) |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
else { |
818
|
|
|
|
|
|
|
treeNavigator.openEnclosingNodes(\$(first_node)); |
819
|
|
|
|
|
|
|
treeNavigator.select(\$(first_node)); |
820
|
|
|
|
|
|
|
} |
821
|
|
|
|
|
|
|
}; |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
// if node is closed and currently has no content, we need to register |
825
|
|
|
|
|
|
|
// a handler, open the node so that it gets its content by Ajax, |
826
|
|
|
|
|
|
|
// and then execute the handler to open the rest after Ajax returns |
827
|
|
|
|
|
|
|
if (treeNavigator.isClosed(node) |
828
|
|
|
|
|
|
|
&& !treeNavigator.content(node)) { |
829
|
|
|
|
|
|
|
treeNavigator.onAfterLoadContent = open_or_select_next; |
830
|
|
|
|
|
|
|
treeNavigator.open(node); |
831
|
|
|
|
|
|
|
} |
832
|
|
|
|
|
|
|
// otherwise just a direct call |
833
|
|
|
|
|
|
|
else { |
834
|
|
|
|
|
|
|
open_or_select_next(); |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
function selectToc(entry) { |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
// build array of intermediate nodes (i.e "Foo", "Foo::Bar", etc.) |
843
|
|
|
|
|
|
|
var parts = entry.split(new RegExp("/|::")); |
844
|
|
|
|
|
|
|
var accu = ''; |
845
|
|
|
|
|
|
|
var sequence = parts.map(function(e) { |
846
|
|
|
|
|
|
|
accu = accu ? (accu + "::" + e) : e; |
847
|
|
|
|
|
|
|
return accu; |
848
|
|
|
|
|
|
|
}); |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
// choose id of first_node by analysis of entry |
851
|
|
|
|
|
|
|
var initial = entry.substr(0, 1); |
852
|
|
|
|
|
|
|
var first_node |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
// CASE module (starting with uppercase) |
855
|
|
|
|
|
|
|
= (initial <= 'Z') ? (initial + ":") |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
// CASE perl* documentation page |
858
|
|
|
|
|
|
|
: entry.search(/^perl/) > -1 ? "perldocs" |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
// CASE other lowercase entries |
861
|
|
|
|
|
|
|
: "pragmas" |
862
|
|
|
|
|
|
|
; |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
// open each node in sequence |
865
|
|
|
|
|
|
|
open_nodes(first_node, sequence); |
866
|
|
|
|
|
|
|
} |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
function setup() { |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
treeNavigator |
871
|
|
|
|
|
|
|
= new GvaScript.TreeNavigator('TN_tree', {tabIndex:-1}); |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
completers.perlfunc = new GvaScript.AutoCompleter( |
874
|
|
|
|
|
|
|
perlfuncs, |
875
|
|
|
|
|
|
|
{minimumChars: 1, |
876
|
|
|
|
|
|
|
minWidth: 100, |
877
|
|
|
|
|
|
|
offsetX: -20, |
878
|
|
|
|
|
|
|
autoSuggestDelay: 400}); |
879
|
|
|
|
|
|
|
completers.perlfunc.onComplete = submit_on_event; |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
completers.perlvar = new GvaScript.AutoCompleter( |
882
|
|
|
|
|
|
|
perlvars, |
883
|
|
|
|
|
|
|
{minimumChars: 1, |
884
|
|
|
|
|
|
|
minWidth: 100, |
885
|
|
|
|
|
|
|
offsetX: -20, |
886
|
|
|
|
|
|
|
autoSuggestDelay: 400}); |
887
|
|
|
|
|
|
|
completers.perlvar.onComplete = submit_on_event; |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
if (!no_indexer) { |
890
|
|
|
|
|
|
|
completers.modlist = new GvaScript.AutoCompleter( |
891
|
|
|
|
|
|
|
"search?source=modlist&search=", |
892
|
|
|
|
|
|
|
{minimumChars: 2, minWidth: 100, offsetX: -20, typeAhead: false}); |
893
|
|
|
|
|
|
|
completers.modlist.onComplete = submit_on_event; |
894
|
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
resize_tree_navigator(); |
897
|
|
|
|
|
|
|
$select_ini |
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
document.observe('dom:loaded', setup); |
901
|
|
|
|
|
|
|
window.onresize = resize_tree_navigator; |
902
|
|
|
|
|
|
|
// Note: observe('resize') doesn't work. Why ? |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
function displayContent(event) { |
905
|
|
|
|
|
|
|
var label = event.controller.label(event.target); |
906
|
|
|
|
|
|
|
if (label && label.tagName == "A") { |
907
|
|
|
|
|
|
|
label.focus(); |
908
|
|
|
|
|
|
|
return Event. stopNone; |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
function maybe_complete(input) { |
913
|
|
|
|
|
|
|
if (input._autocompleter) |
914
|
|
|
|
|
|
|
input._autocompleter.detach(input); |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
switch (input.form.source.selectedIndex) { |
917
|
|
|
|
|
|
|
case 0: completers.perlfunc.autocomplete(input); break; |
918
|
|
|
|
|
|
|
case 1: completers.perlvar.autocomplete(input); break; |
919
|
|
|
|
|
|
|
case 3: if (!no_indexer) |
920
|
|
|
|
|
|
|
completers.modlist.autocomplete(input); |
921
|
|
|
|
|
|
|
break; |
922
|
|
|
|
|
|
|
} |
923
|
|
|
|
|
|
|
} |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
</script> |
927
|
|
|
|
|
|
|
<style> |
928
|
|
|
|
|
|
|
.small_title {color: midnightblue; font-weight: bold; padding: 0 3 0 3} |
929
|
|
|
|
|
|
|
FORM {margin:0px} |
930
|
|
|
|
|
|
|
BODY {margin:0px; font-size: 70%; overflow-x: hidden} |
931
|
|
|
|
|
|
|
DIV {margin:0px; width: 100%} |
932
|
|
|
|
|
|
|
#TN_tree {overflow-y:scroll; overflow-x: hidden} |
933
|
|
|
|
|
|
|
</style> |
934
|
|
|
|
|
|
|
</head> |
935
|
|
|
|
|
|
|
<body> |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
<div id='toc_frame_top'> |
938
|
|
|
|
|
|
|
<div class="small_title" |
939
|
|
|
|
|
|
|
style="text-align:center;border-bottom: 1px solid"> |
940
|
|
|
|
|
|
|
Perl Documentation |
941
|
|
|
|
|
|
|
</div> |
942
|
|
|
|
|
|
|
<div style="text-align:right"> |
943
|
|
|
|
|
|
|
<a href="Pod/POM/Web/Help" class="small_title">Help</a> |
944
|
|
|
|
|
|
|
</div> |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
<form action="search" id="search_form" method="get"> |
947
|
|
|
|
|
|
|
<span class="small_title">Search in</span> |
948
|
|
|
|
|
|
|
<select name="source"> |
949
|
|
|
|
|
|
|
<option>perlfunc</option> |
950
|
|
|
|
|
|
|
<option>perlvar</option> |
951
|
|
|
|
|
|
|
<option>perlfaq</option> |
952
|
|
|
|
|
|
|
<option>modules</option> |
953
|
|
|
|
|
|
|
<option>full-text</option> |
954
|
|
|
|
|
|
|
</select><br> |
955
|
|
|
|
|
|
|
<span class="small_title"> for </span><input |
956
|
|
|
|
|
|
|
name="search" size="15" |
957
|
|
|
|
|
|
|
autocomplete="off" |
958
|
|
|
|
|
|
|
onfocus="maybe_complete(this)"> |
959
|
|
|
|
|
|
|
</form> |
960
|
|
|
|
|
|
|
<br> |
961
|
|
|
|
|
|
|
<div class="small_title" |
962
|
|
|
|
|
|
|
style="border-bottom: 1px solid">Browse</div> |
963
|
|
|
|
|
|
|
</div> |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
<!-- In principle the tree navigator below would best belong in a |
966
|
|
|
|
|
|
|
different frame, but instead it's in a div because the autocompleter |
967
|
|
|
|
|
|
|
from the form above sometimes needs to overlap the tree nav. --> |
968
|
|
|
|
|
|
|
<div id='TN_tree' onPing='displayContent'> |
969
|
|
|
|
|
|
|
@perl_sections |
970
|
|
|
|
|
|
|
$modules |
971
|
|
|
|
|
|
|
</div> |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
</body> |
974
|
|
|
|
|
|
|
</html> |
975
|
|
|
|
|
|
|
__EOHTML__ |
976
|
|
|
|
|
|
|
} |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
|
981
|
2
|
|
|
2
|
0
|
6
|
|
982
|
|
|
|
|
|
|
sub dispatch_search { |
983
|
2
|
|
|
|
|
6
|
my ($self) = @_; |
984
|
2
|
|
|
|
|
5
|
|
985
|
|
|
|
|
|
|
my $params = $self->{params}; |
986
|
|
|
|
|
|
|
my $source = $params->{source}; |
987
|
|
|
|
|
|
|
my $method = {perlfunc => 'perlfunc', |
988
|
|
|
|
|
|
|
perlvar => 'perlvar', |
989
|
|
|
|
|
|
|
perlfaq => 'perlfaq', |
990
|
|
|
|
|
|
|
modules => 'serve_pod', |
991
|
2
|
50
|
|
|
|
21
|
full_text => 'full_text', |
992
|
|
|
|
|
|
|
modlist => 'modlist', |
993
|
2
|
50
|
33
|
|
|
13
|
}->{$source} or die "cannot search in '$source'"; |
994
|
0
|
|
|
|
|
0
|
|
995
|
|
|
|
|
|
|
if ($method =~ /full_text|modlist/ and $no_indexer) { |
996
|
|
|
|
|
|
|
die "<p>this method requires <b>Search::Indexer</b></p>" |
997
|
|
|
|
|
|
|
. "<p>please ask your system administrator to install it</p>" |
998
|
|
|
|
|
|
|
. "(<small>error message : $no_indexer</small>)"; |
999
|
2
|
|
|
|
|
11
|
} |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
return $self->$method($params->{search}); |
1002
|
|
|
|
|
|
|
} |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
my @_perlfunc_items; |
1007
|
2
|
|
|
2
|
0
|
5
|
|
1008
|
|
|
|
|
|
|
sub perlfunc_items { |
1009
|
2
|
100
|
|
|
|
6
|
my ($self) = @_; |
1010
|
1
|
50
|
|
|
|
3
|
|
1011
|
|
|
|
|
|
|
unless (@_perlfunc_items) { |
1012
|
1
|
|
|
|
|
5
|
my ($funcpod) = $self->find_source("perlfunc") |
1013
|
1
|
|
|
|
|
13
|
or die "'perlfunc.pod' does not seem to be installed on this system"; |
|
2
|
|
|
|
|
207
|
|
1014
|
|
|
|
|
|
|
my $funcpom = $self->pod2pom($funcpod); |
1015
|
1
|
|
|
|
|
62
|
my ($description) = grep {$_->title eq 'DESCRIPTION'} $funcpom->head1; |
|
4
|
|
|
|
|
506
|
|
1016
|
1
|
|
|
|
|
56
|
my ($alphalist) |
1017
|
|
|
|
|
|
|
= grep {$_->title =~ /^Alphabetical Listing/i} $description->head2; |
1018
|
2
|
|
|
|
|
17491
|
@_perlfunc_items = $alphalist->over->[0]->item; |
1019
|
|
|
|
|
|
|
}; |
1020
|
|
|
|
|
|
|
return @_perlfunc_items; |
1021
|
|
|
|
|
|
|
} |
1022
|
|
|
|
|
|
|
|
1023
|
1
|
|
|
1
|
0
|
4
|
|
1024
|
1
|
50
|
|
|
|
4
|
sub perlfunc { |
|
378
|
|
|
|
|
53507
|
|
1025
|
|
|
|
|
|
|
my ($self, $func) = @_; |
1026
|
|
|
|
|
|
|
my @items = grep {$_->title =~ /^$func\b/} $self->perlfunc_items |
1027
|
|
|
|
|
|
|
or return $self->send_html("No documentation found for perl " |
1028
|
1
|
|
|
|
|
91
|
."function '<tt>$func</tt>'"); |
1029
|
|
|
|
|
|
|
|
1030
|
1
|
|
|
|
|
5
|
my $view = $self->mk_view(path => "perlfunc/$func"); |
|
2
|
|
|
|
|
79
|
|
1031
|
1
|
|
|
|
|
60
|
|
1032
|
|
|
|
|
|
|
my @li_items = map {$_->present($view)} @items; |
1033
|
|
|
|
|
|
|
return $self->send_html(<<__EOHTML__); |
1034
|
|
|
|
|
|
|
<html> |
1035
|
|
|
|
|
|
|
<head> |
1036
|
|
|
|
|
|
|
<link href="$self->{root_url}/Pod/POM/Web/lib/PodPomWeb.css" rel="stylesheet" type="text/css"> |
1037
|
|
|
|
|
|
|
</head> |
1038
|
|
|
|
|
|
|
<body> |
1039
|
|
|
|
|
|
|
<h2>Extract from <a href="$self->{root_url}/perlfunc">perlfunc</a></h2> |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
<ul>@li_items</ul> |
1042
|
|
|
|
|
|
|
</body> |
1043
|
|
|
|
|
|
|
__EOHTML__ |
1044
|
|
|
|
|
|
|
} |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
my @_perlvar_items; |
1051
|
1
|
|
|
1
|
0
|
3
|
|
1052
|
|
|
|
|
|
|
sub perlvar_items { |
1053
|
1
|
50
|
|
|
|
7
|
my ($self) = @_; |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
unless (@_perlvar_items) { |
1056
|
1
|
50
|
|
|
|
7
|
|
1057
|
|
|
|
|
|
|
|
1058
|
1
|
|
|
|
|
5
|
my ($varpod) = $self->find_source("perlvar") |
1059
|
1
|
|
|
|
|
8
|
or die "'perlvar.pod' does not seem to be installed on this system"; |
1060
|
|
|
|
|
|
|
my $varpom = $self->pod2pom($varpod); |
1061
|
|
|
|
|
|
|
my @items = _extract_items($varpom); |
1062
|
1
|
|
|
|
|
5
|
|
1063
|
1
|
|
|
|
|
4
|
|
1064
|
161
|
|
|
|
|
1972
|
my $tmp = []; |
1065
|
161
|
100
|
|
|
|
658
|
foreach my $item (@items) { |
1066
|
85
|
|
|
|
|
78224
|
push @$tmp, $item; |
1067
|
85
|
|
|
|
|
266
|
if ($item->content . "") { |
1068
|
|
|
|
|
|
|
push @_perlvar_items, $tmp; |
1069
|
|
|
|
|
|
|
$tmp = []; |
1070
|
|
|
|
|
|
|
} |
1071
|
1
|
|
|
|
|
5260
|
} |
1072
|
|
|
|
|
|
|
}; |
1073
|
|
|
|
|
|
|
return @_perlvar_items; |
1074
|
|
|
|
|
|
|
} |
1075
|
|
|
|
|
|
|
|
1076
|
0
|
|
|
0
|
0
|
0
|
|
1077
|
|
|
|
|
|
|
sub perlvar { |
1078
|
0
|
0
|
|
0
|
|
0
|
my ($self, $var) = @_; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
my @items = grep {any {$_->title =~ /^\Q$var\E(\s|$)/} @$_} |
1081
|
|
|
|
|
|
|
$self->perlvar_items |
1082
|
0
|
|
|
|
|
0
|
or return $self->send_html("No documentation found for perl " |
1083
|
|
|
|
|
|
|
."variable '<tt>$var</tt>'"); |
1084
|
0
|
|
|
|
|
0
|
my $view = $self->mk_view(path => "perlvar/$var"); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1085
|
0
|
|
|
|
|
0
|
|
1086
|
|
|
|
|
|
|
my @li_items = map {$_->present($view)} map {@$_} @items; |
1087
|
|
|
|
|
|
|
return $self->send_html(<<__EOHTML__); |
1088
|
|
|
|
|
|
|
<html> |
1089
|
|
|
|
|
|
|
<head> |
1090
|
|
|
|
|
|
|
<link href="$self->{root_url}/Pod/POM/Web/lib/PodPomWeb.css" rel="stylesheet" type="text/css"> |
1091
|
|
|
|
|
|
|
</head> |
1092
|
|
|
|
|
|
|
<body> |
1093
|
|
|
|
|
|
|
<h2>Extract from <a href="$self->{root_url}/perlvar">perlvar</a></h2> |
1094
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
<ul>@li_items</ul> |
1096
|
|
|
|
|
|
|
</body> |
1097
|
|
|
|
|
|
|
__EOHTML__ |
1098
|
|
|
|
|
|
|
} |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
|
1101
|
1
|
|
|
1
|
0
|
4
|
|
1102
|
1
|
|
|
|
|
28
|
sub perlfaq { |
1103
|
1
|
|
|
|
|
3
|
my ($self, $faq_entry) = @_; |
1104
|
1
|
|
|
|
|
2
|
my $regex = qr/\b\Q$faq_entry\E\b/i; |
1105
|
|
|
|
|
|
|
my $answers = ""; |
1106
|
1
|
|
|
|
|
7
|
my $n_answers = 0; |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
my $view = $self->mk_view(path => "perlfaq/$faq_entry"); |
1109
|
1
|
|
|
|
|
5
|
|
1110
|
9
|
|
|
|
|
123536
|
FAQ: |
1111
|
9
|
50
|
|
|
|
63
|
for my $num (1..9) { |
1112
|
|
|
|
|
|
|
my $faq = "perlfaq$num"; |
1113
|
9
|
|
|
|
|
40
|
my ($faqpod) = $self->find_source($faq) |
1114
|
9
|
100
|
|
|
|
87
|
or die "'$faq.pod' does not seem to be installed on this system"; |
|
42
|
|
|
|
|
2122
|
|
|
305
|
|
|
|
|
33905
|
|
1115
|
|
|
|
|
|
|
my $faqpom = $self->pod2pom($faqpod); |
1116
|
4
|
|
|
|
|
82
|
my @questions = map {grep {$_->title =~ $regex} $_->head2} $faqpom->head1 |
|
16
|
|
|
|
|
812
|
|
1117
|
4
|
|
|
|
|
355
|
or next FAQ; |
1118
|
|
|
|
|
|
|
my @nodes = map {$view->print($_)} @questions; |
1119
|
|
|
|
|
|
|
$answers .= generic_node(label => "Found in perlfaq$num", |
1120
|
4
|
|
|
|
|
49
|
label_tag => "h2", |
1121
|
|
|
|
|
|
|
content => join("", @nodes)); |
1122
|
|
|
|
|
|
|
$n_answers += @nodes; |
1123
|
1
|
|
|
|
|
6815
|
} |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
return $self->send_html(<<__EOHTML__); |
1126
|
|
|
|
|
|
|
<html> |
1127
|
|
|
|
|
|
|
<head> |
1128
|
|
|
|
|
|
|
<link href="$self->{root_url}/Alien/GvaScript/lib/GvaScript.css" rel="stylesheet" type="text/css"> |
1129
|
|
|
|
|
|
|
<link href="$self->{root_url}/Pod/POM/Web/lib/PodPomWeb.css" rel="stylesheet" type="text/css"> |
1130
|
|
|
|
|
|
|
<script src="$self->{root_url}/Alien/GvaScript/lib/prototype.js"></script> |
1131
|
|
|
|
|
|
|
<script src="$self->{root_url}/Alien/GvaScript/lib/GvaScript.js"></script> |
1132
|
|
|
|
|
|
|
<script> |
1133
|
|
|
|
|
|
|
var treeNavigator; |
1134
|
|
|
|
|
|
|
function setup() { |
1135
|
|
|
|
|
|
|
treeNavigator = new GvaScript.TreeNavigator('TN_tree'); |
1136
|
|
|
|
|
|
|
} |
1137
|
|
|
|
|
|
|
window.onload = setup; |
1138
|
|
|
|
|
|
|
</script> |
1139
|
|
|
|
|
|
|
</head> |
1140
|
|
|
|
|
|
|
<body> |
1141
|
|
|
|
|
|
|
<h1>Extracts from <a href="$self->{root_url}/perlfaq">perlfaq</a></h1><br> |
1142
|
|
|
|
|
|
|
<em>searching for '$faq_entry' : $n_answers answers</em><br><br> |
1143
|
|
|
|
|
|
|
<div id='TN_tree'> |
1144
|
|
|
|
|
|
|
$answers |
1145
|
|
|
|
|
|
|
</div> |
1146
|
|
|
|
|
|
|
</body> |
1147
|
|
|
|
|
|
|
__EOHTML__ |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
} |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
|
1156
|
4
|
|
|
4
|
0
|
32
|
|
1157
|
|
|
|
|
|
|
sub mk_view { |
1158
|
|
|
|
|
|
|
my ($self, %args) = @_; |
1159
|
|
|
|
|
|
|
|
1160
|
4
|
|
|
|
|
76
|
my $view = Pod::POM::View::HTML::_PerlDoc->new( |
1161
|
|
|
|
|
|
|
root_url => $self->{root_url}, |
1162
|
|
|
|
|
|
|
%args |
1163
|
4
|
|
|
|
|
339
|
); |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
return $view; |
1166
|
|
|
|
|
|
|
} |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
|
1169
|
9
|
|
|
9
|
0
|
40
|
|
1170
|
|
|
|
|
|
|
sub send_html { |
1171
|
|
|
|
|
|
|
my ($self, $html, $mtime) = @_; |
1172
|
9
|
|
|
|
|
252
|
|
1173
|
|
|
|
|
|
|
|
1174
|
9
|
|
|
|
|
263
|
$html =~ s[<head>] |
1175
|
|
|
|
|
|
|
[<head>\n<meta http-equiv="X-UA-Compatible" content="IE=edge">]; |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
$self->send_content({content => encode_utf8($html), code => 200, mtime => $mtime, charset => 'UTF-8'}); |
1178
|
|
|
|
|
|
|
} |
1179
|
|
|
|
|
|
|
|
1180
|
10
|
|
|
10
|
0
|
35
|
|
1181
|
|
|
|
|
|
|
|
1182
|
10
|
|
|
|
|
33
|
sub send_content { |
1183
|
10
|
|
|
|
|
27
|
my ($self, $args) = @_; |
1184
|
10
|
|
100
|
|
|
58
|
|
1185
|
10
|
100
|
66
|
|
|
81
|
my $charset = $args->{charset}; |
1186
|
10
|
|
|
|
|
137
|
my $length = length $args->{content}; |
1187
|
10
|
|
100
|
|
|
42
|
my $mime_type = $args->{mime_type} || "text/html"; |
1188
|
|
|
|
|
|
|
$mime_type .= "; charset=$charset" if $charset and $mime_type =~ /html/; |
1189
|
10
|
|
|
|
|
29
|
my $modified = gmtime $args->{mtime}; |
1190
|
10
|
|
|
|
|
44
|
my $code = $args->{code} || 200; |
1191
|
|
|
|
|
|
|
|
1192
|
10
|
50
|
|
|
|
67
|
my $r = $self->{response}; |
1193
|
0
|
|
|
|
|
0
|
for (ref $r) { |
1194
|
0
|
|
|
|
|
0
|
|
1195
|
0
|
|
|
|
|
0
|
/^Apache/ and do { |
1196
|
0
|
0
|
|
|
|
0
|
require Apache2::Response; |
1197
|
0
|
|
|
|
|
0
|
$r->content_type($mime_type); |
1198
|
0
|
|
|
|
|
0
|
$r->set_content_length($length); |
1199
|
|
|
|
|
|
|
$r->set_last_modified($args->{mtime}) if $args->{mtime}; |
1200
|
|
|
|
|
|
|
$r->print($args->{content}); |
1201
|
10
|
50
|
|
|
|
52
|
return; |
1202
|
10
|
|
|
|
|
71
|
}; |
1203
|
10
|
|
|
|
|
206
|
|
1204
|
|
|
|
|
|
|
/^HTTP::Response/ and do { |
1205
|
10
|
100
|
|
|
|
1190
|
$r->code($code); |
1206
|
10
|
|
|
|
|
189
|
$r->header(Content_type => $mime_type, |
1207
|
10
|
|
|
|
|
443
|
Content_length => $length); |
1208
|
|
|
|
|
|
|
$r->header(Last_modified => $modified) if $args->{mtime}; |
1209
|
|
|
|
|
|
|
$r->add_content($args->{content}); |
1210
|
|
|
|
|
|
|
return; |
1211
|
0
|
|
|
|
|
0
|
}; |
1212
|
0
|
0
|
|
|
|
0
|
|
1213
|
0
|
|
|
|
|
0
|
|
1214
|
0
|
|
|
|
|
0
|
my $headers = "Content-type: $mime_type\nContent-length: $length\n"; |
1215
|
0
|
|
|
|
|
0
|
$headers .= "Last-modified: $modified\n" if $args->{mtime}; |
1216
|
|
|
|
|
|
|
binmode(STDOUT); |
1217
|
|
|
|
|
|
|
print "$headers\n$args->{content}"; |
1218
|
|
|
|
|
|
|
return; |
1219
|
|
|
|
|
|
|
} |
1220
|
|
|
|
|
|
|
} |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
|
1227
|
43
|
|
|
43
|
0
|
132
|
|
1228
|
43
|
|
100
|
|
|
129
|
|
1229
|
43
|
|
66
|
|
|
172
|
sub generic_node { |
1230
|
43
|
|
100
|
|
|
150
|
my %args = @_; |
1231
|
43
|
|
66
|
|
|
181
|
$args{class} ||= "TN_node"; |
1232
|
|
|
|
|
|
|
$args{attrs} &&= " $args{attrs}"; |
1233
|
43
|
100
|
|
|
|
115
|
$args{content} ||= ""; |
1234
|
|
|
|
|
|
|
$args{content} &&= qq{<div class="TN_content">$args{content}</div>}; |
1235
|
43
|
|
66
|
|
|
153
|
my ($default_label_tag, $label_attrs) |
1236
|
43
|
|
100
|
|
|
118
|
= $args{href} ? ("a", qq{ href='$args{href}'}) |
1237
|
43
|
50
|
|
|
|
84
|
: ("span", "" ); |
1238
|
0
|
|
|
|
|
0
|
$args{label_tag} ||= $default_label_tag; |
1239
|
0
|
|
|
|
|
0
|
$args{label_class} ||= "TN_label"; |
1240
|
|
|
|
|
|
|
if ($args{abstract}) { |
1241
|
|
|
|
|
|
|
$args{abstract} =~ s/([&<>"])/$escape_entity{$1}/g; |
1242
|
|
|
|
|
|
|
$label_attrs .= qq{ title="$args{abstract}"}; |
1243
|
|
|
|
|
|
|
} |
1244
|
|
|
|
|
|
|
return qq{<div class="$args{class}"$args{attrs}>} |
1245
|
|
|
|
|
|
|
. qq{<$args{label_tag} class="$args{label_class}"$label_attrs>} |
1246
|
43
|
|
|
|
|
365
|
. $args{label} |
1247
|
|
|
|
|
|
|
. qq{</$args{label_tag}>} |
1248
|
|
|
|
|
|
|
. $args{content} |
1249
|
|
|
|
|
|
|
. qq{</div>}; |
1250
|
|
|
|
|
|
|
} |
1251
|
29
|
|
|
29
|
0
|
54
|
|
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
sub closed_node { |
1254
|
|
|
|
|
|
|
return generic_node(@_, class => "TN_node TN_closed"); |
1255
|
0
|
|
|
0
|
0
|
0
|
} |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
sub leaf { |
1258
|
|
|
|
|
|
|
return generic_node(@_, class => "TN_leaf"); |
1259
|
|
|
|
|
|
|
} |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
|
1265
|
14
|
|
|
14
|
0
|
50
|
|
1266
|
14
|
50
|
|
|
|
871
|
|
1267
|
14
|
50
|
|
|
|
239
|
sub slurp_file { |
1268
|
14
|
|
|
|
|
109
|
my ($self, $file, $io_layer) = @_; |
1269
|
14
|
|
|
|
|
18731
|
open my $fh, "<", $file or die "open $file: $!"; |
1270
|
|
|
|
|
|
|
binmode($fh, $io_layer) if $io_layer; |
1271
|
|
|
|
|
|
|
local $/ = undef; |
1272
|
|
|
|
|
|
|
return <$fh>; |
1273
|
|
|
|
|
|
|
} |
1274
|
1
|
|
|
1
|
0
|
4
|
|
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
sub parse_version { |
1277
|
1
|
|
|
1
|
|
9
|
my ($self, $content, $mod_name) = @_; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
36
|
|
1278
|
1
|
50
|
|
|
|
927
|
|
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
open my $fh, "<", \$content; |
1281
|
1
|
|
|
|
|
4249
|
my $mm = Module::Metadata->new_from_handle($fh, $mod_name) |
1282
|
|
|
|
|
|
|
or die "couldn't create Module::Metadata"; |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
return $mm->version; |
1285
|
|
|
|
|
|
|
} |
1286
|
|
|
|
|
|
|
|
1287
|
247
|
|
|
247
|
|
324
|
|
1288
|
|
|
|
|
|
|
|
1289
|
247
|
|
|
|
|
815
|
sub _extract_items { |
1290
|
247
|
100
|
|
|
|
3954
|
my $node = shift; |
1291
|
86
|
100
|
|
|
|
315
|
|
|
246
|
|
|
|
|
689
|
|
1292
|
|
|
|
|
|
|
for ($node->type) { |
1293
|
66
|
|
|
|
|
122
|
/^item/ and return ($node); |
1294
|
|
|
|
|
|
|
/^(pod|head|over)/ and return map {_extract_items($_)} $node->content; |
1295
|
|
|
|
|
|
|
} |
1296
|
|
|
|
|
|
|
return (); |
1297
|
|
|
|
|
|
|
} |
1298
|
|
|
|
|
|
|
|
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
1; |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
|
1303
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
|
1306
|
1
|
|
|
1
|
|
23
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
56
|
|
1307
|
1
|
|
|
1
|
|
8
|
package Pod::POM::View::HTML::_PerlDoc; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
61
|
|
1308
|
1
|
|
|
1
|
|
6
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
70
|
|
1309
|
1
|
|
|
1
|
|
8
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
845
|
|
1310
|
1
|
|
|
1
|
|
6700
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
13
|
|
1311
|
1
|
|
|
1
|
|
111
|
no warnings qw/uninitialized/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
22
|
|
1312
|
|
|
|
|
|
|
use base qw/Pod::POM::View::HTML/; |
1313
|
|
|
|
|
|
|
use POSIX qw/strftime/; |
1314
|
|
|
|
|
|
|
use List::MoreUtils qw/firstval/; |
1315
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
|
1317
|
451
|
|
|
451
|
|
8682
|
|
1318
|
|
|
|
|
|
|
|
1319
|
451
|
|
|
|
|
692
|
sub view_seq_text { |
1320
|
451
|
|
|
|
|
740
|
my ($self, $text) = @_; |
1321
|
451
|
|
|
|
|
591
|
|
1322
|
451
|
|
|
|
|
768
|
for ($text) { |
1323
|
|
|
|
|
|
|
s/&/&/g; |
1324
|
|
|
|
|
|
|
s/</</g; |
1325
|
451
|
|
|
|
|
1226
|
s/>/>/g; |
1326
|
|
|
|
|
|
|
} |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
return $text; |
1329
|
|
|
|
|
|
|
} |
1330
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
|
1332
|
38
|
|
|
38
|
|
368
|
|
1333
|
|
|
|
|
|
|
|
1334
|
|
|
|
|
|
|
sub view_seq_link { |
1335
|
|
|
|
|
|
|
my ($self, $link) = @_; |
1336
|
38
|
|
|
|
|
48
|
|
1337
|
38
|
100
|
|
|
|
153
|
|
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
my $link_text; |
1340
|
38
|
|
|
|
|
102
|
$link =~ s/^([^|]+)\|// and $link_text = $1; |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
|
1343
|
38
|
|
|
|
|
117
|
my $is_external_resource = ($link =~ m[^\w+://]); |
1344
|
38
|
|
|
|
|
908
|
|
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
my $linked = $self->SUPER::view_seq_link($link); |
1347
|
38
|
100
|
|
|
|
167
|
my ($url, $label) = ($linked =~ m[^<a href="(.*?)">(.*)</a>]); |
|
15
|
|
|
|
|
41
|
|
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
|
1350
|
38
|
100
|
|
|
|
133
|
$url =~ s[#(.*)]['#' . _title_to_id($1)]e unless $is_external_resource; |
|
|
100
|
|
|
|
|
|
1351
|
10
|
|
|
|
|
19
|
|
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
if ($link_text) { |
1354
|
|
|
|
|
|
|
$label = $link_text; |
1355
|
26
|
50
|
|
|
|
57
|
} |
|
5
|
|
|
|
|
28
|
|
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
elsif ($label !~ m{^\w+://}s) { |
1358
|
|
|
|
|
|
|
$label =~ s[^(.*?)/(.*)$][$1 ? "$2 in $1" : $2]e ; |
1359
|
38
|
100
|
|
|
|
99
|
} |
1360
|
38
|
|
|
|
|
233
|
|
1361
|
|
|
|
|
|
|
|
1362
|
|
|
|
|
|
|
my $target = $is_external_resource ? " target='_blank'" : ""; |
1363
|
|
|
|
|
|
|
return qq{<a href="$url"$target>$label</a>}; |
1364
|
|
|
|
|
|
|
} |
1365
|
|
|
|
|
|
|
|
1366
|
57
|
|
|
57
|
|
986
|
|
1367
|
57
|
|
|
|
|
168
|
|
1368
|
57
|
|
|
|
|
196
|
sub view_seq_link_transform_path { |
1369
|
|
|
|
|
|
|
my($self, $page) = @_; |
1370
|
|
|
|
|
|
|
$page =~ s[::][/]g; |
1371
|
|
|
|
|
|
|
return "$self->{root_url}/$page"; |
1372
|
|
|
|
|
|
|
} |
1373
|
21
|
|
|
21
|
|
1433
|
|
1374
|
|
|
|
|
|
|
|
1375
|
21
|
|
50
|
|
|
38
|
sub view_item { |
1376
|
21
|
50
|
|
|
|
188
|
my ($self, $item) = @_; |
1377
|
|
|
|
|
|
|
|
1378
|
21
|
|
|
|
|
42
|
my $title = eval {$item->title->present($self)} || ""; |
1379
|
21
|
|
|
|
|
47
|
$title = "" if $title =~ /^\s*\*\s*$/; |
1380
|
21
|
|
33
|
|
|
119
|
|
1381
|
|
|
|
|
|
|
my $class = ""; |
1382
|
21
|
|
|
|
|
103
|
my $id = _title_to_id($title); |
1383
|
21
|
50
|
|
|
|
380
|
$id &&= qq{ id="$id"}; |
1384
|
21
|
|
|
|
|
105
|
|
1385
|
|
|
|
|
|
|
my $content = $item->content->present($self); |
1386
|
|
|
|
|
|
|
$title = qq{<b>$title</b>} if $title; |
1387
|
|
|
|
|
|
|
return qq{<li$id$class>$title\n$content</li>\n}; |
1388
|
|
|
|
|
|
|
} |
1389
|
|
|
|
|
|
|
|
1390
|
72
|
|
|
72
|
|
124
|
|
1391
|
72
|
|
|
|
|
141
|
|
1392
|
72
|
|
|
|
|
196
|
sub _title_to_id { |
1393
|
72
|
|
|
|
|
430
|
my $title = shift; |
1394
|
72
|
|
|
|
|
351
|
$title =~ s/<.*?>//g; |
1395
|
72
|
|
|
|
|
170
|
$title =~ s/[,(].*//; |
1396
|
|
|
|
|
|
|
$title =~ s/\s*$//; |
1397
|
|
|
|
|
|
|
$title =~ s/[^A-Za-z0-9_]/_/g; |
1398
|
|
|
|
|
|
|
return $title; |
1399
|
|
|
|
|
|
|
} |
1400
|
1
|
|
|
1
|
|
34
|
|
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
sub view_pod { |
1403
|
1
|
50
|
|
|
|
7
|
my ($self, $pom) = @_; |
1404
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
|
1406
|
|
|
|
|
|
|
my $content = $pom->content->present($self) |
1407
|
|
|
|
|
|
|
or return "no documentation found in <tt>$self->{path}</tt><br>\n" |
1408
|
1
|
|
|
1
|
|
69
|
. "<a href='$self->{root_url}/source/$self->{path}'>Source</a>"; |
|
1
|
|
|
|
|
29
|
|
1409
|
1
|
50
|
|
|
|
95
|
|
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
my $name_h1 = firstval {$_->title =~ /^(NAME|TITLE)\b/} $pom->head1(); |
1412
|
1
|
|
|
|
|
122
|
my $doc_title = $name_h1 ? $name_h1->content->present('Pod::POM::View') |
1413
|
1
|
|
33
|
|
|
6
|
|
1414
|
1
|
|
|
|
|
4
|
: 'Untitled'; |
1415
|
|
|
|
|
|
|
my ($name, $description) = ($doc_title =~ /^\s*(.*?)\s+-+\s+(.*)/); |
1416
|
|
|
|
|
|
|
$name ||= $doc_title; |
1417
|
1
|
|
|
|
|
119
|
$name =~ s/\n.*//s; |
1418
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
|
1420
|
1
|
|
|
|
|
11
|
my $installed = strftime("%x", localtime($self->{mtime})); |
1421
|
|
|
|
|
|
|
|
1422
|
1
|
50
|
|
|
|
6
|
|
1423
|
|
|
|
|
|
|
my ($version, $core_release, $orig_version, $cpan_info, $module_refs) |
1424
|
|
|
|
|
|
|
= ("") x 6; |
1425
|
1
|
50
|
|
|
|
28
|
if (my $mod_name = $self->{mod_name}) { |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
|
1428
|
1
|
|
50
|
|
|
18
|
$version = $self->{version} ? "v. $self->{version}, " : ""; |
1429
|
|
|
|
|
|
|
|
1430
|
1
|
|
50
|
|
|
472
|
|
1431
|
1
|
|
33
|
|
|
4
|
$core_release = Module::CoreList->first_release($mod_name) || ""; |
1432
|
1
|
|
33
|
|
|
5
|
$orig_version |
1433
|
|
|
|
|
|
|
= $Module::CoreList::version{$core_release}{$mod_name} || ""; |
1434
|
|
|
|
|
|
|
$orig_version &&= "v. $orig_version "; |
1435
|
1
|
|
|
|
|
5
|
$core_release &&= "; ${orig_version}entered Perl core in $core_release"; |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
|
1438
|
|
|
|
|
|
|
$module_refs = qq{<br> |
1439
|
|
|
|
|
|
|
<a href="https://metacpan.org/pod/$mod_name" |
1440
|
1
|
50
|
|
|
|
5
|
target="_blank">meta::cpan</a> |
1441
|
0
|
|
|
|
|
0
|
}; |
1442
|
0
|
0
|
|
|
|
0
|
|
1443
|
0
|
|
|
|
|
0
|
if ($has_cpan) { |
1444
|
|
|
|
|
|
|
my $mod = CPAN::Shell->expand("Module", $mod_name); |
1445
|
0
|
0
|
|
|
|
0
|
if ($mod) { |
1446
|
|
|
|
|
|
|
my $cpan_version = $mod->cpan_version; |
1447
|
|
|
|
|
|
|
$cpan_info = "; CPAN has v. $cpan_version" |
1448
|
|
|
|
|
|
|
if $cpan_version ne $self->{version}; |
1449
|
|
|
|
|
|
|
} |
1450
|
1
|
|
|
|
|
7
|
} |
1451
|
|
|
|
|
|
|
} |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
my $toc = $self->make_toc($pom, 0); |
1454
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
return <<__EOHTML__ |
1456
|
|
|
|
|
|
|
<html> |
1457
|
|
|
|
|
|
|
<head> |
1458
|
|
|
|
|
|
|
<title>$name</title> |
1459
|
|
|
|
|
|
|
<link href="$self->{root_url}/Alien/GvaScript/lib/GvaScript.css" rel="stylesheet" type="text/css"> |
1460
|
|
|
|
|
|
|
<link href="$self->{root_url}/Pod/POM/Web/lib/PodPomWeb.css" rel="stylesheet" type="text/css"> |
1461
|
|
|
|
|
|
|
<script src="$self->{root_url}/Alien/GvaScript/lib/prototype.js"></script> |
1462
|
|
|
|
|
|
|
<script src="$self->{root_url}/Alien/GvaScript/lib/GvaScript.js"></script> |
1463
|
|
|
|
|
|
|
<script> |
1464
|
|
|
|
|
|
|
var treeNavigator; |
1465
|
|
|
|
|
|
|
function setup() { |
1466
|
|
|
|
|
|
|
new GvaScript.TreeNavigator( |
1467
|
|
|
|
|
|
|
'TN_tree', |
1468
|
|
|
|
|
|
|
{selectFirstNode: (location.hash ? false : true), |
1469
|
|
|
|
|
|
|
tabIndex: 0} |
1470
|
|
|
|
|
|
|
); |
1471
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
var tocFrame = window.parent.frames.tocFrame; |
1473
|
|
|
|
|
|
|
if (tocFrame) { |
1474
|
|
|
|
|
|
|
try {tocFrame.eval("selectToc('$name')")} |
1475
|
|
|
|
|
|
|
catch(e) {}; |
1476
|
|
|
|
|
|
|
} |
1477
|
|
|
|
|
|
|
} |
1478
|
|
|
|
|
|
|
window.onload = setup; |
1479
|
|
|
|
|
|
|
function jumpto_href(event) { |
1480
|
|
|
|
|
|
|
var label = event.controller.label(event.target); |
1481
|
|
|
|
|
|
|
if (label && label.tagName == "A") { |
1482
|
|
|
|
|
|
|
/* label.focus(); */ |
1483
|
|
|
|
|
|
|
return Event.stopNone; |
1484
|
|
|
|
|
|
|
} |
1485
|
|
|
|
|
|
|
} |
1486
|
|
|
|
|
|
|
</script> |
1487
|
|
|
|
|
|
|
<style> |
1488
|
|
|
|
|
|
|
#TOC .TN_content .TN_label {font-size: 80%; font-weight: bold} |
1489
|
|
|
|
|
|
|
#TOC .TN_leaf .TN_label {font-weight: normal} |
1490
|
|
|
|
|
|
|
|
1491
|
|
|
|
|
|
|
#ref_box { |
1492
|
|
|
|
|
|
|
clear: right; |
1493
|
|
|
|
|
|
|
float: right; |
1494
|
|
|
|
|
|
|
text-align: right; |
1495
|
|
|
|
|
|
|
font-size: 80%; |
1496
|
|
|
|
|
|
|
} |
1497
|
|
|
|
|
|
|
#title_descr { |
1498
|
|
|
|
|
|
|
clear: right; |
1499
|
|
|
|
|
|
|
float: right; |
1500
|
|
|
|
|
|
|
font-style: italic; |
1501
|
|
|
|
|
|
|
margin-top: 8px; |
1502
|
|
|
|
|
|
|
margin-bottom: 8px; |
1503
|
|
|
|
|
|
|
padding: 5px; |
1504
|
|
|
|
|
|
|
text-align: center; |
1505
|
|
|
|
|
|
|
border: 3px double #888; |
1506
|
|
|
|
|
|
|
} |
1507
|
|
|
|
|
|
|
</style> |
1508
|
|
|
|
|
|
|
</head> |
1509
|
|
|
|
|
|
|
<body> |
1510
|
|
|
|
|
|
|
<div id='TN_tree'> |
1511
|
|
|
|
|
|
|
<div class="TN_node"> |
1512
|
|
|
|
|
|
|
<h1 class="TN_label">$name</h1> |
1513
|
|
|
|
|
|
|
<small>(${version}installed $installed$core_release$cpan_info)</small> |
1514
|
|
|
|
|
|
|
|
1515
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
<span id="title_descr">$description</span> |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
<span id="ref_box"> |
1519
|
|
|
|
|
|
|
<a href="$self->{root_url}/source/$self->{path}">Source</a> |
1520
|
|
|
|
|
|
|
$module_refs |
1521
|
|
|
|
|
|
|
</span> |
1522
|
|
|
|
|
|
|
|
1523
|
|
|
|
|
|
|
<div class="TN_content"> |
1524
|
|
|
|
|
|
|
<div class="TN_node" onPing="jumpto_href" id="TOC"> |
1525
|
|
|
|
|
|
|
<h3 class="TN_label">Table of contents</h3> |
1526
|
|
|
|
|
|
|
<div class="TN_content"> |
1527
|
|
|
|
|
|
|
$toc |
1528
|
|
|
|
|
|
|
</div> |
1529
|
|
|
|
|
|
|
</div> |
1530
|
|
|
|
|
|
|
<hr/> |
1531
|
|
|
|
|
|
|
</div> |
1532
|
|
|
|
|
|
|
</div> |
1533
|
|
|
|
|
|
|
$content |
1534
|
|
|
|
|
|
|
</div> |
1535
|
|
|
|
|
|
|
</body> |
1536
|
1
|
|
|
|
|
59
|
</html> |
1537
|
|
|
|
|
|
|
__EOHTML__ |
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
} |
1540
|
1
|
|
|
1
|
|
8
|
|
1541
|
1
|
|
|
1
|
|
2260
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
158
|
|
1542
|
6
|
|
|
|
|
838
|
BEGIN { |
1543
|
26
|
|
|
26
|
|
1049
|
for my $num (1..6) { |
1544
|
26
|
|
|
|
|
135
|
no strict 'refs'; |
1545
|
26
|
|
|
|
|
203
|
*{"view_head$num"} = sub { |
1546
|
26
|
|
|
|
|
129
|
my ($self, $item) = @_; |
1547
|
26
|
|
|
|
|
612
|
my $title = $item->title->present($self); |
1548
|
|
|
|
|
|
|
my $id = _title_to_id($title); |
1549
|
|
|
|
|
|
|
my $content = $item->content->present($self); |
1550
|
|
|
|
|
|
|
my $h_num = $num + 1; |
1551
|
|
|
|
|
|
|
return <<EOHTML |
1552
|
|
|
|
|
|
|
<div class="TN_node" id="$id"> |
1553
|
|
|
|
|
|
|
<h$h_num class="TN_label">$title</h$h_num> |
1554
|
|
|
|
|
|
|
<div class="TN_content"> |
1555
|
|
|
|
|
|
|
$content |
1556
|
26
|
|
|
|
|
236
|
</div> |
1557
|
6
|
|
|
|
|
23
|
</div> |
1558
|
|
|
|
|
|
|
EOHTML |
1559
|
|
|
|
|
|
|
} |
1560
|
|
|
|
|
|
|
} |
1561
|
|
|
|
|
|
|
} |
1562
|
10
|
|
|
10
|
|
97
|
|
1563
|
10
|
|
|
|
|
30
|
|
1564
|
|
|
|
|
|
|
sub view_seq_index { |
1565
|
|
|
|
|
|
|
my ($self, $item) = @_; |
1566
|
|
|
|
|
|
|
return ""; |
1567
|
|
|
|
|
|
|
} |
1568
|
59
|
|
|
59
|
|
1182
|
|
1569
|
|
|
|
|
|
|
|
1570
|
59
|
|
|
|
|
106
|
sub view_verbatim { |
1571
|
59
|
100
|
|
|
|
117
|
my ($self, $text) = @_; |
1572
|
5
|
|
|
|
|
15
|
|
1573
|
5
|
|
|
|
|
22
|
my $coloring = $self->{syntax_coloring}; |
1574
|
|
|
|
|
|
|
if ($coloring) { |
1575
|
|
|
|
|
|
|
my $method = "${coloring}_coloring"; |
1576
|
54
|
|
|
|
|
308
|
$text = $self->$method($text); |
1577
|
|
|
|
|
|
|
} |
1578
|
|
|
|
|
|
|
else { |
1579
|
|
|
|
|
|
|
$text =~ s/([&<>"])/$Pod::POM::Web::escape_entity{$1}/g; |
1580
|
59
|
|
|
|
|
428
|
} |
|
29
|
|
|
|
|
95
|
|
1581
|
29
|
|
|
|
|
382
|
|
1582
|
|
|
|
|
|
|
|
1583
|
59
|
100
|
|
|
|
218
|
$text =~ s{(\buse\b(?:</span>)?\ +(?:<span.*?>)?)([\w:]+)} |
1584
|
1
|
|
|
|
|
3
|
{my $url = $self->view_seq_link_transform_path($2); |
1585
|
1
|
|
|
|
|
146
|
qq{$1<a href="$url">$2</a>} }eg; |
|
353
|
|
|
|
|
904
|
|
1586
|
|
|
|
|
|
|
|
1587
|
59
|
|
|
|
|
422
|
if ($self->{line_numbering}) { |
1588
|
|
|
|
|
|
|
my $line = 1; |
1589
|
|
|
|
|
|
|
$text =~ s/^/sprintf "%6d\t", $line++/egm; |
1590
|
|
|
|
|
|
|
} |
1591
|
|
|
|
|
|
|
return qq{<pre class="$coloring">$text</pre>}; |
1592
|
|
|
|
|
|
|
} |
1593
|
5
|
|
|
5
|
|
16
|
|
1594
|
5
|
|
|
|
|
35
|
|
1595
|
5
|
|
|
|
|
156
|
|
1596
|
|
|
|
|
|
|
sub PPI_coloring { |
1597
|
5
|
50
|
|
|
|
431717
|
my ($self, $text) = @_; |
1598
|
5
|
|
|
|
|
710
|
my $ppi = PPI::HTML->new(); |
1599
|
5
|
|
|
|
|
90
|
my $html = $ppi->html(\$text); |
1600
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
if ($html) { |
1602
|
0
|
|
|
|
|
0
|
$html =~ s/<br>//g; |
1603
|
0
|
|
|
|
|
0
|
return $html; |
1604
|
|
|
|
|
|
|
} |
1605
|
|
|
|
|
|
|
else { |
1606
|
|
|
|
|
|
|
$text =~ s/([&<>"])/$Pod::POM::Web::escape_entity{$1}/g; |
1607
|
|
|
|
|
|
|
return $text; |
1608
|
|
|
|
|
|
|
} |
1609
|
0
|
|
|
0
|
|
0
|
} |
1610
|
0
|
|
|
|
|
0
|
|
1611
|
0
|
|
|
|
|
0
|
|
1612
|
|
|
|
|
|
|
sub SCINEPLEX_coloring { |
1613
|
|
|
|
|
|
|
my ($self, $text) = @_; |
1614
|
|
|
|
|
|
|
eval { |
1615
|
0
|
|
|
|
|
0
|
$text = ActiveState::Scineplex::Annotate($text, |
1616
|
|
|
|
|
|
|
'perl', |
1617
|
|
|
|
|
|
|
outputFormat => 'html'); |
1618
|
|
|
|
|
|
|
}; |
1619
|
|
|
|
|
|
|
return $text; |
1620
|
|
|
|
|
|
|
} |
1621
|
|
|
|
|
|
|
|
1622
|
|
|
|
|
|
|
|
1623
|
11
|
|
|
11
|
|
22
|
|
1624
|
|
|
|
|
|
|
|
1625
|
11
|
|
|
|
|
17
|
|
1626
|
11
|
|
|
|
|
23
|
sub make_toc { |
1627
|
11
|
|
|
|
|
51
|
my ($self, $item, $level) = @_; |
1628
|
|
|
|
|
|
|
|
1629
|
11
|
|
|
|
|
163
|
my $html = ""; |
1630
|
10
|
|
|
|
|
37
|
my $method = "head" . ($level + 1); |
1631
|
10
|
|
|
|
|
64
|
my $sub_items = $item->$method; |
1632
|
|
|
|
|
|
|
|
1633
|
10
|
|
|
|
|
33
|
foreach my $sub_item (@$sub_items) { |
1634
|
10
|
100
|
|
|
|
22
|
my $title = $sub_item->title->present($self); |
1635
|
10
|
|
66
|
|
|
24
|
my $id = _title_to_id($title); |
1636
|
|
|
|
|
|
|
|
1637
|
10
|
|
|
|
|
51
|
my $node_content = $self->make_toc($sub_item, $level + 1); |
1638
|
|
|
|
|
|
|
my $class = $node_content ? "TN_node" : "TN_leaf"; |
1639
|
|
|
|
|
|
|
$node_content &&= qq{<div class="TN_content">$node_content</div>}; |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
$html .= qq{<div class="$class">} |
1642
|
|
|
|
|
|
|
. qq{<a class="TN_label" href="#$id">$title</a>} |
1643
|
11
|
|
|
|
|
24
|
. $node_content |
1644
|
|
|
|
|
|
|
. qq{</div>}; |
1645
|
|
|
|
|
|
|
} |
1646
|
|
|
|
|
|
|
|
1647
|
|
|
|
0
|
|
|
return $html; |
1648
|
|
|
|
|
|
|
} |
1649
|
|
|
|
|
|
|
|
1650
|
|
|
|
|
|
|
|
1651
|
|
|
|
|
|
|
sub DESTROY {} |
1652
|
|
|
|
|
|
|
|
1653
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
1; |
1655
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
|
1657
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
__END__ |
1659
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
=encoding ISO8859-1 |
1661
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
=head1 NAME |
1663
|
|
|
|
|
|
|
|
1664
|
|
|
|
|
|
|
Pod::POM::Web - HTML Perldoc server |
1665
|
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
=head1 DESCRIPTION |
1667
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
L<Pod::POM::Web> is a Web application for browsing |
1669
|
|
|
|
|
|
|
the documentation of Perl components installed |
1670
|
|
|
|
|
|
|
on your local machine. Since pages are dynamically |
1671
|
|
|
|
|
|
|
generated, they are always in sync with code actually |
1672
|
|
|
|
|
|
|
installed. |
1673
|
|
|
|
|
|
|
|
1674
|
|
|
|
|
|
|
The application offers |
1675
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
=over |
1677
|
|
|
|
|
|
|
|
1678
|
|
|
|
|
|
|
=item * |
1679
|
|
|
|
|
|
|
|
1680
|
|
|
|
|
|
|
a tree view for browsing through installed modules |
1681
|
|
|
|
|
|
|
(with dynamic expansion of branches as they are visited) |
1682
|
|
|
|
|
|
|
|
1683
|
|
|
|
|
|
|
=item * |
1684
|
|
|
|
|
|
|
|
1685
|
|
|
|
|
|
|
a tree view for navigating and opening / closing sections while |
1686
|
|
|
|
|
|
|
visiting a documentation page |
1687
|
|
|
|
|
|
|
|
1688
|
|
|
|
|
|
|
=item * |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
a source code view with hyperlinks between used modules |
1691
|
|
|
|
|
|
|
and optionally with syntax coloring |
1692
|
|
|
|
|
|
|
(see section L</"Optional features">) |
1693
|
|
|
|
|
|
|
|
1694
|
|
|
|
|
|
|
|
1695
|
|
|
|
|
|
|
=item * |
1696
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
direct access to L<perlfunc> entries (builtin Perl functions) |
1698
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
=item * |
1700
|
|
|
|
|
|
|
|
1701
|
|
|
|
|
|
|
search through L<perlfaq> headers |
1702
|
|
|
|
|
|
|
|
1703
|
|
|
|
|
|
|
=item * |
1704
|
|
|
|
|
|
|
|
1705
|
|
|
|
|
|
|
full-text search, including names of Perl variables |
1706
|
|
|
|
|
|
|
(this is an optional feature -- see section L</"Optional features">). |
1707
|
|
|
|
|
|
|
|
1708
|
|
|
|
|
|
|
=item * |
1709
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
parsing and display of version number |
1711
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
=item * |
1713
|
|
|
|
|
|
|
|
1714
|
|
|
|
|
|
|
display if and when the displayed module entered Perl core. |
1715
|
|
|
|
|
|
|
|
1716
|
|
|
|
|
|
|
=item * |
1717
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
parsing pod links and translating them into hypertext links |
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
=item * |
1721
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
links to CPAN sites |
1723
|
|
|
|
|
|
|
|
1724
|
|
|
|
|
|
|
=back |
1725
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
The application may be hosted by an existing Web server, or otherwise |
1727
|
|
|
|
|
|
|
may run its own builtin Web server. |
1728
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
The DHTML code for navigating through documentation trees requires a |
1730
|
|
|
|
|
|
|
modern browser. So far it has been tested on Microsoft Internet |
1731
|
|
|
|
|
|
|
Explorer 8.0, Firefox 3.5, Google Chrome 3.0 and Safari 4.0.4. |
1732
|
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
=head1 USAGE |
1734
|
|
|
|
|
|
|
|
1735
|
|
|
|
|
|
|
Usage is described in a separate document |
1736
|
|
|
|
|
|
|
L<Pod::POM::Web::Help>. |
1737
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
=head1 INSTALLATION |
1739
|
|
|
|
|
|
|
|
1740
|
|
|
|
|
|
|
=head2 Starting the Web application |
1741
|
|
|
|
|
|
|
|
1742
|
|
|
|
|
|
|
Once the code is installed (most probably through |
1743
|
|
|
|
|
|
|
L<CPAN> or L<CPANPLUS>), you have to configure |
1744
|
|
|
|
|
|
|
the web server : |
1745
|
|
|
|
|
|
|
|
1746
|
|
|
|
|
|
|
=head3 As a mod_perl service |
1747
|
|
|
|
|
|
|
|
1748
|
|
|
|
|
|
|
If you have Apache2 with mod_perl 2.0, then edit your |
1749
|
|
|
|
|
|
|
F<perl.conf> as follows : |
1750
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
PerlModule Apache2::RequestRec |
1752
|
|
|
|
|
|
|
PerlModule Apache2::RequestIO |
1753
|
|
|
|
|
|
|
<Location /perldoc> |
1754
|
|
|
|
|
|
|
SetHandler modperl |
1755
|
|
|
|
|
|
|
PerlResponseHandler Pod::POM::Web->handler |
1756
|
|
|
|
|
|
|
</Location> |
1757
|
|
|
|
|
|
|
|
1758
|
|
|
|
|
|
|
Then navigate to URL L<http://localhost/perldoc>. |
1759
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
=head3 As a cgi-bin script |
1761
|
|
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
Alternatively, you can run this application as a cgi-script |
1763
|
|
|
|
|
|
|
by writing a simple file F<perldoc> in your C<cgi-bin> directory, |
1764
|
|
|
|
|
|
|
containing : |
1765
|
|
|
|
|
|
|
|
1766
|
|
|
|
|
|
|
#!/path/to/perl |
1767
|
|
|
|
|
|
|
use Pod::POM::Web; |
1768
|
|
|
|
|
|
|
Pod::POM::Web->handler; |
1769
|
|
|
|
|
|
|
|
1770
|
|
|
|
|
|
|
Make this script executable, |
1771
|
|
|
|
|
|
|
then navigate to URL L<http://localhost/cgi-bin/perldoc>. |
1772
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
The same can be done for running under mod_perl Registry |
1774
|
|
|
|
|
|
|
(write the same script as above and put it in your |
1775
|
|
|
|
|
|
|
Apache/perl directory). However, this does not make much sense, |
1776
|
|
|
|
|
|
|
because if you have mod_perl Registry then you could as well |
1777
|
|
|
|
|
|
|
run it as a basic mod_perl handler. |
1778
|
|
|
|
|
|
|
|
1779
|
|
|
|
|
|
|
=head3 As a standalone server |
1780
|
|
|
|
|
|
|
|
1781
|
|
|
|
|
|
|
A third way to use this application is to start a process invoking |
1782
|
|
|
|
|
|
|
the builtin HTTP server : |
1783
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
perl -MPod::POM::Web -e server |
1785
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
This is useful if you have no other HTTP server, or if |
1787
|
|
|
|
|
|
|
you want to run this module under the perl debugger. |
1788
|
|
|
|
|
|
|
The server will listen at L<http://localhost:8080>. |
1789
|
|
|
|
|
|
|
A different port may be specified, in several ways : |
1790
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
perl -MPod::POM::Web -e server 8888 |
1792
|
|
|
|
|
|
|
perl -MPod::POM::Web -e server(8888) |
1793
|
|
|
|
|
|
|
perl -MPod::POM::Web -e server -- --port 8888 |
1794
|
|
|
|
|
|
|
|
1795
|
|
|
|
|
|
|
=head2 Opening a specific initial page |
1796
|
|
|
|
|
|
|
|
1797
|
|
|
|
|
|
|
By default, the initial page displayed by the application |
1798
|
|
|
|
|
|
|
is F<perl>. This can be changed by supplying an C<open> argument |
1799
|
|
|
|
|
|
|
with the name of any documentation page: for example |
1800
|
|
|
|
|
|
|
|
1801
|
|
|
|
|
|
|
http://localhost:8080?open=Pod/POM/Web |
1802
|
|
|
|
|
|
|
http://localhost:8080?open=perlfaq |
1803
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
=head2 Setting a specific title |
1805
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
If you run several instances of C<Pod::POM::Web> simultaneously, you may |
1807
|
|
|
|
|
|
|
want them to have distinct titles. This can be done like this: |
1808
|
|
|
|
|
|
|
|
1809
|
|
|
|
|
|
|
perl -MPod::POM::Web -e server -- --title "My Own Perl Doc" |
1810
|
|
|
|
|
|
|
|
1811
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
=head1 MISCELLANEOUS |
1813
|
|
|
|
|
|
|
|
1814
|
|
|
|
|
|
|
=head2 Note about security |
1815
|
|
|
|
|
|
|
|
1816
|
|
|
|
|
|
|
This application is intended as a power tool for Perl developers, |
1817
|
|
|
|
|
|
|
not as an Internet application. It will give access to any file |
1818
|
|
|
|
|
|
|
installed under your C<@INC> path or Apache C<lib/perl> directory |
1819
|
|
|
|
|
|
|
(but not outside of those directories); |
1820
|
|
|
|
|
|
|
so it is probably a B<bad idea> |
1821
|
|
|
|
|
|
|
to put it on a public Internet server. |
1822
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
|
1824
|
|
|
|
|
|
|
=head2 Optional features |
1825
|
|
|
|
|
|
|
|
1826
|
|
|
|
|
|
|
=head3 Syntax coloring |
1827
|
|
|
|
|
|
|
|
1828
|
|
|
|
|
|
|
Syntax coloring improves readability of code excerpts. |
1829
|
|
|
|
|
|
|
If your Perl distribution is from ActiveState, then |
1830
|
|
|
|
|
|
|
C<Pod::POM::Web> will take advantage |
1831
|
|
|
|
|
|
|
of the L<ActiveState::Scineplex> module |
1832
|
|
|
|
|
|
|
which is already installed on your system. Otherwise, |
1833
|
|
|
|
|
|
|
you need to install L<PPI::HTML>, available from CPAN. |
1834
|
|
|
|
|
|
|
|
1835
|
|
|
|
|
|
|
=head3 Full-text indexing |
1836
|
|
|
|
|
|
|
|
1837
|
|
|
|
|
|
|
C<Pod::POM::Web> can index the documentation and source code |
1838
|
|
|
|
|
|
|
of all your installed modules, including Perl variable names, |
1839
|
|
|
|
|
|
|
C<Names:::Of::Modules>, etc. To use this feature you need to |
1840
|
|
|
|
|
|
|
|
1841
|
|
|
|
|
|
|
=over |
1842
|
|
|
|
|
|
|
|
1843
|
|
|
|
|
|
|
=item * |
1844
|
|
|
|
|
|
|
|
1845
|
|
|
|
|
|
|
install L<Search::Indexer> from CPAN |
1846
|
|
|
|
|
|
|
|
1847
|
|
|
|
|
|
|
=item * |
1848
|
|
|
|
|
|
|
|
1849
|
|
|
|
|
|
|
build the index as described in L<Pod::POM::Web::Indexer> documentation. |
1850
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
=back |
1852
|
|
|
|
|
|
|
|
1853
|
|
|
|
|
|
|
|
1854
|
|
|
|
|
|
|
=head1 HINTS TO POD AUTHORING |
1855
|
|
|
|
|
|
|
|
1856
|
|
|
|
|
|
|
=head2 Images |
1857
|
|
|
|
|
|
|
|
1858
|
|
|
|
|
|
|
The Pod::Pom::Web server also serves non-pod files within the C<@INC> |
1859
|
|
|
|
|
|
|
hierarchy. This is useful for example to include images in your |
1860
|
|
|
|
|
|
|
documentation, by inserting chunks of HTML as follows : |
1861
|
|
|
|
|
|
|
|
1862
|
|
|
|
|
|
|
=for html |
1863
|
|
|
|
|
|
|
<img src="pretty_diagram.jpg"> |
1864
|
|
|
|
|
|
|
|
1865
|
|
|
|
|
|
|
or |
1866
|
|
|
|
|
|
|
|
1867
|
|
|
|
|
|
|
=for html |
1868
|
|
|
|
|
|
|
<object type="image/svg+xml" data="try.svg" width="640" height="480"> |
1869
|
|
|
|
|
|
|
</object> |
1870
|
|
|
|
|
|
|
|
1871
|
|
|
|
|
|
|
Here it is assumed that auxiliary files C<pretty_diagram.jpg> or |
1872
|
|
|
|
|
|
|
C<try.svg> are in the same directory than the POD source; but |
1873
|
|
|
|
|
|
|
of course relative or absolute links can be used. |
1874
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
|
1876
|
|
|
|
|
|
|
|
1877
|
|
|
|
|
|
|
=head1 METHODS |
1878
|
|
|
|
|
|
|
|
1879
|
|
|
|
|
|
|
=head2 handler |
1880
|
|
|
|
|
|
|
|
1881
|
|
|
|
|
|
|
Pod::POM::Web->handler($request, $response, $options); |
1882
|
|
|
|
|
|
|
|
1883
|
|
|
|
|
|
|
Public entry point for serving a request. Objects C<$request> and |
1884
|
|
|
|
|
|
|
C<$response> are specific to the hosting HTTP server (modperl, HTTP::Daemon |
1885
|
|
|
|
|
|
|
or cgi-bin); C<$options> is a hashref that can contain |
1886
|
|
|
|
|
|
|
|
1887
|
|
|
|
|
|
|
=over |
1888
|
|
|
|
|
|
|
|
1889
|
|
|
|
|
|
|
=item C<page_title> |
1890
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
for specifying the HTML title |
1892
|
|
|
|
|
|
|
of the application (useful if you run several concurrent instances |
1893
|
|
|
|
|
|
|
of Pod::POM::Web). |
1894
|
|
|
|
|
|
|
|
1895
|
|
|
|
|
|
|
=item C<port> |
1896
|
|
|
|
|
|
|
|
1897
|
|
|
|
|
|
|
the HTTP port listening for requests |
1898
|
|
|
|
|
|
|
|
1899
|
|
|
|
|
|
|
=item C<module_dirs> |
1900
|
|
|
|
|
|
|
|
1901
|
|
|
|
|
|
|
directories for searching for modules, |
1902
|
|
|
|
|
|
|
in addition to the standard ones installed with your perl executable. |
1903
|
|
|
|
|
|
|
|
1904
|
|
|
|
|
|
|
|
1905
|
|
|
|
|
|
|
=item <script_dirs> |
1906
|
|
|
|
|
|
|
|
1907
|
|
|
|
|
|
|
additional directories for searching for scripts |
1908
|
|
|
|
|
|
|
|
1909
|
|
|
|
|
|
|
=back |
1910
|
|
|
|
|
|
|
|
1911
|
|
|
|
|
|
|
|
1912
|
|
|
|
|
|
|
|
1913
|
|
|
|
|
|
|
|
1914
|
|
|
|
|
|
|
=head2 server |
1915
|
|
|
|
|
|
|
|
1916
|
|
|
|
|
|
|
Pod::POM::Web->server($port, $options); |
1917
|
|
|
|
|
|
|
|
1918
|
|
|
|
|
|
|
Starts the event loop for the builtin HTTP server. |
1919
|
|
|
|
|
|
|
The C<$port> number can be given as optional first argument |
1920
|
|
|
|
|
|
|
(default is 8080). The second argument C<$options> may be |
1921
|
|
|
|
|
|
|
used to specify a page title (see L</"handler"> method above). |
1922
|
|
|
|
|
|
|
|
1923
|
|
|
|
|
|
|
This function is exported into the C<main::> namespace if perl |
1924
|
|
|
|
|
|
|
is called with the C<-e> flag, so that you can write |
1925
|
|
|
|
|
|
|
|
1926
|
|
|
|
|
|
|
perl -MPod::POM::Web -e server |
1927
|
|
|
|
|
|
|
|
1928
|
|
|
|
|
|
|
Options and port may be specified on the command line : |
1929
|
|
|
|
|
|
|
|
1930
|
|
|
|
|
|
|
perl -MPod::POM::Web -e server -- --port 8888 --title FooBar |
1931
|
|
|
|
|
|
|
|
1932
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
1933
|
|
|
|
|
|
|
|
1934
|
|
|
|
|
|
|
This web application was deeply inspired by : |
1935
|
|
|
|
|
|
|
|
1936
|
|
|
|
|
|
|
=over |
1937
|
|
|
|
|
|
|
|
1938
|
|
|
|
|
|
|
=item * |
1939
|
|
|
|
|
|
|
|
1940
|
|
|
|
|
|
|
the structure of HTML Perl documentation released with |
1941
|
|
|
|
|
|
|
ActivePerl (L<http://www.activeperl.com/ASPN/Perl>). |
1942
|
|
|
|
|
|
|
|
1943
|
|
|
|
|
|
|
|
1944
|
|
|
|
|
|
|
=item * |
1945
|
|
|
|
|
|
|
|
1946
|
|
|
|
|
|
|
the excellent tree navigation in Microsoft's former MSDN Library Web site |
1947
|
|
|
|
|
|
|
-- since they rebuilt the site, keyboard navigation has gone ! |
1948
|
|
|
|
|
|
|
|
1949
|
|
|
|
|
|
|
=item * |
1950
|
|
|
|
|
|
|
|
1951
|
|
|
|
|
|
|
the standalone HTTP server implemented in L<Pod::WebServer>. |
1952
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
=item * |
1954
|
|
|
|
|
|
|
|
1955
|
|
|
|
|
|
|
the wide possibilities of Andy Wardley's L<Pod::POM> parser. |
1956
|
|
|
|
|
|
|
|
1957
|
|
|
|
|
|
|
=back |
1958
|
|
|
|
|
|
|
|
1959
|
|
|
|
|
|
|
Thanks |
1960
|
|
|
|
|
|
|
to Philippe Bruhat who mentioned a weakness in the API, |
1961
|
|
|
|
|
|
|
to Chris Dolan who supplied many useful suggestions and patches |
1962
|
|
|
|
|
|
|
(esp. integration with AnnoCPAN), |
1963
|
|
|
|
|
|
|
to Rémi Pauchet who pointed out a regression bug with Firefox CSS, |
1964
|
|
|
|
|
|
|
to Alexandre Jousset who fixed a bug in the TOC display, |
1965
|
|
|
|
|
|
|
to Cédric Bouvier who pointed out a IO bug in serving binary files, |
1966
|
|
|
|
|
|
|
to Elliot Shank who contributed the "page_title" option, |
1967
|
|
|
|
|
|
|
to Olivier 'dolmen' Mengué who suggested to export "server" into C<main::>, |
1968
|
|
|
|
|
|
|
to Ben Bullock who added the 403 message for absent modules, |
1969
|
|
|
|
|
|
|
and to Paul Cochrane for several improvements in the doc and in the |
1970
|
|
|
|
|
|
|
repository structure. |
1971
|
|
|
|
|
|
|
|
1972
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
=head1 RELEASE NOTES |
1974
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
Indexed information since version 1.04 is not compatible |
1976
|
|
|
|
|
|
|
with previous versions. |
1977
|
|
|
|
|
|
|
|
1978
|
|
|
|
|
|
|
So if you upgraded from a previous version and want to use |
1979
|
|
|
|
|
|
|
the index, you need to rebuild it entirely, by running the |
1980
|
|
|
|
|
|
|
command : |
1981
|
|
|
|
|
|
|
|
1982
|
|
|
|
|
|
|
perl -MPod::POM::Web::Indexer -e "index(-from_scratch => 1)" |
1983
|
|
|
|
|
|
|
|
1984
|
|
|
|
|
|
|
|
1985
|
|
|
|
|
|
|
|
1986
|
|
|
|
|
|
|
=head1 AUTHOR |
1987
|
|
|
|
|
|
|
|
1988
|
|
|
|
|
|
|
Laurent Dami, C<< <dami AT cpan DOT org> >> |
1989
|
|
|
|
|
|
|
|
1990
|
|
|
|
|
|
|
|
1991
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
1992
|
|
|
|
|
|
|
|
1993
|
|
|
|
|
|
|
Copyright 2007-2021 Laurent Dami, all rights reserved. |
1994
|
|
|
|
|
|
|
|
1995
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
1996
|
|
|
|
|
|
|
under the same terms as Perl itself. |
1997
|
|
|
|
|
|
|
|
1998
|
|
|
|
|
|
|
=head1 TODO |
1999
|
|
|
|
|
|
|
|
2000
|
|
|
|
|
|
|
- real tests ! |
2001
|
|
|
|
|
|
|
- factorization (esp. initial <head> in html pages) |
2002
|
|
|
|
|
|
|
- use Getopts to choose colouring package, toggle CPAN, etc. |
2003
|
|
|
|
|
|
|
- declare Pod::POM bugs |
2004
|
|
|
|
|
|
|
- perlre : line 1693 improper parsing of L<C<< (?>pattern) >>> |
2005
|
|
|
|
|
|
|
- bug: doc files taken as pragmas (lwptut, lwpcook, pip, pler) |
2006
|
|
|
|
|
|
|
- exploit doc index X<...> |
2007
|
|
|
|
|
|
|
- do something with perllocal (installation history) |
2008
|
|
|
|
|
|
|
- restrict to given set of paths/ modules |
2009
|
|
|
|
|
|
|
- need to change toc (no perlfunc, no scripts/pragmas, etc) |
2010
|
|
|
|
|
|
|
- treenav with letter entries or not ? |
2011
|
|
|
|
|
|
|
- port to Plack |
2012
|
|
|
|
|
|
|
|