line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Pod::PerldocJp; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
41601
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
40
|
|
4
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
31
|
|
5
|
1
|
|
|
1
|
|
5
|
use base 'Pod::Perldoc'; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
1330
|
|
6
|
1
|
|
|
1
|
|
24596
|
use Encode; |
|
1
|
|
|
|
|
12381
|
|
|
1
|
|
|
|
|
81
|
|
7
|
1
|
|
|
1
|
|
774
|
use Encode::Guess; |
|
1
|
|
|
|
|
4301
|
|
|
1
|
|
|
|
|
5
|
|
8
|
1
|
|
|
1
|
|
721
|
use Term::Encoding; |
|
1
|
|
|
|
|
498
|
|
|
1
|
|
|
|
|
49
|
|
9
|
1
|
|
|
1
|
|
698105
|
use HTTP::Tiny; |
|
1
|
|
|
|
|
803367
|
|
|
1
|
|
|
|
|
52
|
|
10
|
1
|
|
|
1
|
|
1319
|
use Path::Tiny; |
|
1
|
|
|
|
|
9715
|
|
|
1
|
|
|
|
|
58
|
|
11
|
1
|
|
|
1
|
|
807
|
use URI::Escape; |
|
1
|
|
|
|
|
1324
|
|
|
1
|
|
|
|
|
62
|
|
12
|
1
|
|
|
1
|
|
917
|
use utf8; |
|
1
|
|
|
|
|
9
|
|
|
1
|
|
|
|
|
7
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
my $term_encoding = Term::Encoding::get_encoding() || 'utf-8'; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = '0.18'; |
17
|
|
|
|
|
|
|
|
18
|
0
|
|
|
0
|
1
|
|
sub opt_J { shift->_elem('opt_J', @_) } |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub _perldocjp_dir { |
21
|
0
|
|
|
0
|
|
|
my $self = shift; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
my @subs = ( |
24
|
|
|
|
|
|
|
sub { |
25
|
0
|
|
|
0
|
|
|
require File::HomeDir; |
26
|
0
|
|
|
|
|
|
path(File::HomeDir->my_home, '.perldocjp'); |
27
|
|
|
|
|
|
|
}, |
28
|
0
|
|
|
0
|
|
|
sub { path(File::Spec->tmpdir, '.perldocjp') }, |
29
|
0
|
|
|
0
|
|
|
sub { path('.') }, |
30
|
0
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
0
|
|
|
|
|
|
foreach my $sub (@subs) { |
33
|
0
|
0
|
|
|
|
|
my $dir = eval { $sub->() } or next; |
|
0
|
|
|
|
|
|
|
34
|
0
|
|
|
|
|
|
$dir->mkpath; |
35
|
0
|
0
|
0
|
|
|
|
return $dir if -d $dir && -w $dir; |
36
|
|
|
|
|
|
|
}; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub grand_search_init { |
40
|
0
|
|
|
0
|
1
|
|
my ($self, $pages, @found) = @_; |
41
|
|
|
|
|
|
|
|
42
|
0
|
0
|
|
|
|
|
my $dir = $self->_perldocjp_dir() |
43
|
|
|
|
|
|
|
or return $self->SUPER::grand_search_init($pages, @found); |
44
|
|
|
|
|
|
|
|
45
|
0
|
|
0
|
|
|
|
my @encodings = |
46
|
|
|
|
|
|
|
split ' ', $ENV{PERLDOCJP_ENCODINGS} || 'euc-jp shiftjis utf8'; |
47
|
|
|
|
|
|
|
|
48
|
0
|
0
|
0
|
|
|
|
if ($self->opt_J or ($pages->[0] && $pages->[0] =~ /^https?:/)) { |
|
|
|
0
|
|
|
|
|
49
|
0
|
|
|
|
|
|
my $ua = HTTP::Tiny->new(agent => "Pod-PerldocJp/$VERSION"); |
50
|
|
|
|
|
|
|
|
51
|
0
|
|
0
|
|
|
|
my $api_url = $ENV{PERLDOCJP_SERVER} || 'http://perldoc.charsbar.org/api/pod'; |
52
|
0
|
|
|
|
|
|
$api_url =~ s|/+$||; |
53
|
|
|
|
|
|
|
|
54
|
0
|
|
|
|
|
|
foreach my $page (@$pages) { |
55
|
0
|
|
|
|
|
|
$self->aside("Searching for $page\n"); |
56
|
0
|
0
|
|
|
|
|
my $url = ($page =~ /^https?:/) ? $page : "$api_url/$page"; |
57
|
0
|
|
|
|
|
|
my $file = $dir->child(uri_escape($page, '^A-Za-z0-9_') . '.pod'); |
58
|
0
|
0
|
0
|
|
|
|
unless ($file->exists && $file->stat->size && $file->stat->mtime > time - 60 * 60 * 24) { |
|
|
|
0
|
|
|
|
|
59
|
0
|
|
|
|
|
|
my $res = $ua->mirror($url => "$file"); |
60
|
0
|
0
|
0
|
|
|
|
if ($res->{success} && (my $pod = $file->slurp) !~ /^=encoding\s/m) { |
61
|
|
|
|
|
|
|
# You can't trust perldoc.jp's Content-Type too much. |
62
|
|
|
|
|
|
|
# (there're several utf-8 translations, though perldoc.jp |
63
|
|
|
|
|
|
|
# is (or was) supposed to use euc-jp) |
64
|
0
|
|
|
|
|
|
my $encoding; |
65
|
0
|
|
|
|
|
|
my $enc = guess_encoding($pod, @encodings); |
66
|
0
|
0
|
|
|
|
|
if (ref $enc) { |
|
|
0
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
$encoding = $enc->name; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
elsif (my $ctype = $res->{headers}{'content-type'}) { |
70
|
0
|
|
|
|
|
|
($encoding) = $ctype =~ /charset\s*=\s*([\w-]+)/; |
71
|
|
|
|
|
|
|
} |
72
|
0
|
0
|
|
|
|
|
if ($encoding) { |
73
|
0
|
|
|
|
|
|
$pod = "=encoding $encoding\n\n$pod"; |
74
|
0
|
|
|
|
|
|
$file->spew($pod); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
} |
78
|
0
|
0
|
|
|
|
|
push @found, "$file" if $file->stat->size; |
79
|
|
|
|
|
|
|
} |
80
|
0
|
0
|
|
|
|
|
return @found if @found; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
0
|
|
|
|
|
|
@found = $self->SUPER::grand_search_init($pages, @found); |
84
|
|
|
|
|
|
|
|
85
|
0
|
0
|
|
|
|
|
if ($self->opt_J) { |
86
|
0
|
|
|
|
|
|
foreach my $path (@found) { |
87
|
0
|
|
|
|
|
|
my $pod = path($path)->slurp; |
88
|
0
|
0
|
|
|
|
|
unless ($pod =~ /^=encoding\s/m) { |
89
|
0
|
|
|
|
|
|
my $encoding; |
90
|
0
|
|
|
|
|
|
my $enc = guess_encoding($pod, @encodings); |
91
|
0
|
0
|
|
|
|
|
if (ref $enc) { |
92
|
0
|
|
|
|
|
|
$encoding = $enc->name; |
93
|
0
|
0
|
|
|
|
|
next if $encoding eq 'ascii'; |
94
|
0
|
|
|
|
|
|
$pod = "=encoding $encoding\n\n$pod"; |
95
|
0
|
|
|
|
|
|
my $file = $dir->child(uri_escape($path, '^A-Za-z0-9_')); |
96
|
0
|
|
|
|
|
|
$file->spew($pod); |
97
|
0
|
0
|
|
|
|
|
$path = "$file" if $file->stat->size; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
} |
102
|
0
|
|
|
|
|
|
@found; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
{ |
106
|
|
|
|
|
|
|
# shamelessly ripped from Pod::Perldoc 3.23 and tweaked |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub opt_o_with { # "o" for output format |
109
|
0
|
|
|
0
|
1
|
|
my($self, $rest) = @_; |
110
|
0
|
0
|
0
|
|
|
|
return unless defined $rest and length $rest; |
111
|
0
|
0
|
|
|
|
|
if($rest =~ m/^(\w+)$/s) { |
112
|
0
|
|
|
|
|
|
$rest = $1; #untaint |
113
|
|
|
|
|
|
|
} else { |
114
|
0
|
|
|
|
|
|
$self->warn( qq("$rest" isn't a valid output format. Skipping.\n") ); |
115
|
0
|
|
|
|
|
|
return; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
$self->aside("Noting \"$rest\" as desired output format...\n"); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# Figure out what class(es) that could actually mean... |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
|
my @classes; |
123
|
|
|
|
|
|
|
# TWEAKED: to include "Pod::PerldocJp::To" |
124
|
0
|
|
|
|
|
|
foreach my $prefix ("Pod::PerldocJp::To", "Pod::Perldoc::To", "Pod::Simple::", "Pod::") { |
125
|
|
|
|
|
|
|
# Messy but smart: |
126
|
0
|
|
|
|
|
|
foreach my $stem ( |
127
|
|
|
|
|
|
|
$rest, # Yes, try it first with the given capitalization |
128
|
|
|
|
|
|
|
"\L$rest", "\L\u$rest", "\U$rest" # And then try variations |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
) { |
131
|
0
|
|
|
|
|
|
$self->aside("Considering $prefix$stem\n"); |
132
|
0
|
|
|
|
|
|
push @classes, $prefix . $stem; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
# Tidier, but misses too much: |
136
|
|
|
|
|
|
|
#push @classes, $prefix . ucfirst(lc($rest)); |
137
|
|
|
|
|
|
|
} |
138
|
0
|
|
|
|
|
|
$self->opt_M_with( join ";", @classes ); |
139
|
0
|
|
|
|
|
|
return; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub init_formatter_class_list { |
143
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
144
|
0
|
|
0
|
|
|
|
$self->{'formatter_classes'} ||= []; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# Remember, no switches have been read yet, when |
147
|
|
|
|
|
|
|
# we've started this routine. |
148
|
|
|
|
|
|
|
|
149
|
0
|
|
|
|
|
|
$self->opt_M_with('Pod::Perldoc::ToPod'); # the always-there fallthru |
150
|
0
|
|
|
|
|
|
$self->opt_o_with('text'); |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# TWEAKED: XXX: should support term later |
153
|
|
|
|
|
|
|
# $self->opt_o_with('term') unless $self->is_mswin32 || $self->is_dos |
154
|
|
|
|
|
|
|
# || !($ENV{TERM} && ( |
155
|
|
|
|
|
|
|
# ($ENV{TERM} || '') !~ /dumb|emacs|none|unknown/i |
156
|
|
|
|
|
|
|
# )); |
157
|
|
|
|
|
|
|
|
158
|
0
|
|
|
|
|
|
return; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub maybe_generate_dynamic_pod { |
162
|
0
|
|
|
0
|
1
|
|
my ($self, $found_things) = @_; |
163
|
0
|
|
|
|
|
|
my @dynamic_pod; |
164
|
|
|
|
|
|
|
|
165
|
0
|
0
|
|
|
|
|
$self->search_perlapi($found_things, \@dynamic_pod) if $self->opt_a; |
166
|
|
|
|
|
|
|
|
167
|
0
|
0
|
|
|
|
|
$self->search_perlfunc($found_things, \@dynamic_pod) if $self->opt_f; |
168
|
|
|
|
|
|
|
|
169
|
0
|
0
|
|
|
|
|
$self->search_perlvar($found_things, \@dynamic_pod) if $self->opt_v; |
170
|
|
|
|
|
|
|
|
171
|
0
|
0
|
|
|
|
|
$self->search_perlfaqs($found_things, \@dynamic_pod) if $self->opt_q; |
172
|
|
|
|
|
|
|
|
173
|
0
|
0
|
0
|
|
|
|
if( ! $self->opt_f and ! $self->opt_q and ! $self->opt_v and ! $self->opt_a) { |
|
|
0
|
|
|
|
|
|
174
|
0
|
|
|
|
|
|
Pod::Perldoc::DEBUG > 4 and print "That's a non-dynamic pod search.\n"; |
175
|
|
|
|
|
|
|
} elsif ( @dynamic_pod ) { |
176
|
0
|
|
|
|
|
|
$self->aside("Hm, I found some Pod from that search!\n"); |
177
|
0
|
|
|
|
|
|
my ($buffd, $buffer) = $self->new_tempfile('pod', 'dyn'); |
178
|
0
|
0
|
0
|
|
|
|
if ( $] >= 5.008 && $self->opt_L ) { |
179
|
0
|
|
|
|
|
|
binmode($buffd, ":utf8"); |
180
|
0
|
|
|
|
|
|
print $buffd "=encoding utf8\n\n"; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
0
|
|
|
|
|
|
push @{ $self->{'temp_file_list'} }, $buffer; |
|
0
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# I.e., it MIGHT be deleted at the end. |
185
|
|
|
|
|
|
|
|
186
|
0
|
|
0
|
|
|
|
my $in_list = !$self->not_dynamic && $self->opt_f || $self->opt_v || $self->opt_a; |
187
|
|
|
|
|
|
|
# TWEAKED: to add =encoding utf-8 and encode_utf8 |
188
|
0
|
|
|
|
|
|
print $buffd "=encoding utf-8\n\n"; |
189
|
0
|
0
|
|
|
|
|
print $buffd "=over 8\n\n" if $in_list; |
190
|
0
|
0
|
|
|
|
|
print $buffd map {encode_utf8($_)} @dynamic_pod or die "Can't print $buffer: $!"; |
|
0
|
|
|
|
|
|
|
191
|
0
|
0
|
|
|
|
|
print $buffd "=back\n" if $in_list; |
192
|
|
|
|
|
|
|
|
193
|
0
|
0
|
|
|
|
|
close $buffd or $self->die( "Can't close $buffer: $!" ); |
194
|
|
|
|
|
|
|
|
195
|
0
|
|
|
|
|
|
@$found_things = $buffer; |
196
|
|
|
|
|
|
|
# Yes, so found_things never has more than one thing in |
197
|
|
|
|
|
|
|
# it, by time we leave here |
198
|
|
|
|
|
|
|
|
199
|
0
|
|
|
|
|
|
$self->add_formatter_option('__filter_nroff' => 1); |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
} else { |
202
|
0
|
|
|
|
|
|
@$found_things = (); |
203
|
0
|
|
|
|
|
|
$self->aside("I found no Pod from that search!\n"); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
|
return; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub search_perlfunc { |
210
|
0
|
|
|
0
|
1
|
|
my($self, $found_things, $pod) = @_; |
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
|
Pod::Perldoc::DEBUG > 2 and print "Search: @$found_things\n"; |
213
|
|
|
|
|
|
|
|
214
|
0
|
|
|
|
|
|
my $perlfunc = shift @$found_things; |
215
|
0
|
0
|
|
|
|
|
open(PFUNC, "<", $perlfunc) # "Funk is its own reward" |
216
|
|
|
|
|
|
|
or $self->die("Can't open $perlfunc: $!"); |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# Functions like -r, -e, etc. are listed under `-X'. |
219
|
0
|
0
|
|
|
|
|
my $search_re = ($self->opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/) |
220
|
|
|
|
|
|
|
? '(?:I<)?-X' : quotemeta($self->opt_f) ; |
221
|
|
|
|
|
|
|
|
222
|
0
|
|
|
|
|
|
Pod::Perldoc::DEBUG > 2 and |
223
|
|
|
|
|
|
|
print "Going to perlfunc-scan for $search_re in $perlfunc\n"; |
224
|
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
my $re = 'Alphabetical Listing of Perl Functions'; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# Check available translator or backup to default (english) |
228
|
0
|
0
|
0
|
|
|
|
if ( $self->opt_L && defined $self->{'translators'}->[0] ) { |
229
|
0
|
|
|
|
|
|
my $tr = $self->{'translators'}->[0]; |
230
|
0
|
0
|
|
|
|
|
$re = $tr->search_perlfunc_re if $tr->can('search_perlfunc_re'); |
231
|
0
|
0
|
|
|
|
|
if ( $] < 5.008 ) { |
232
|
0
|
|
|
|
|
|
$self->aside("Your old perl doesn't really have proper unicode support."); |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
else { |
235
|
0
|
|
|
|
|
|
binmode(PFUNC, ":utf8"); |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# Skip introduction |
240
|
0
|
|
|
|
|
|
local $_; |
241
|
|
|
|
|
|
|
# TWEAKED: to find encoding |
242
|
0
|
|
|
|
|
|
my $encoding = 'utf-8'; |
243
|
0
|
|
|
|
|
|
while () { |
244
|
0
|
0
|
|
|
|
|
if (/^=encoding\s+(\S+)/) { |
245
|
0
|
|
|
|
|
|
$encoding = $1; |
246
|
|
|
|
|
|
|
} |
247
|
0
|
0
|
|
|
|
|
last if /^=head2 $re/; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# Look for our function |
251
|
0
|
|
|
|
|
|
my $found = 0; |
252
|
0
|
|
|
|
|
|
my $inlist = 0; |
253
|
|
|
|
|
|
|
|
254
|
0
|
|
|
|
|
|
my @perlops = qw(m q qq qr qx qw s tr y); |
255
|
|
|
|
|
|
|
|
256
|
0
|
|
|
|
|
|
my @related; |
257
|
|
|
|
|
|
|
my $related_re; |
258
|
0
|
|
|
|
|
|
while () { # "The Mothership Connection is here!" |
259
|
0
|
0
|
|
|
|
|
last if( grep{ $self->opt_f eq $_ }@perlops ); |
|
0
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
|
261
|
0
|
0
|
0
|
|
|
|
if ( /^=over/ and not $found ) { |
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
262
|
0
|
|
|
|
|
|
++$inlist; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
elsif ( /^=back/ and not $found and $inlist ) { |
265
|
0
|
|
|
|
|
|
--$inlist; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
|
269
|
0
|
0
|
0
|
|
|
|
if ( m/^=item\s+$search_re\b/ and $inlist < 2 ) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
270
|
0
|
|
|
|
|
|
$found = 1; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
elsif (@related > 1 and /^=item/) { |
273
|
0
|
|
0
|
|
|
|
$related_re ||= join "|", @related; |
274
|
0
|
0
|
|
|
|
|
if (m/^=item\s+(?:$related_re)\b/) { |
275
|
0
|
|
|
|
|
|
$found = 1; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
else { |
278
|
0
|
0
|
0
|
|
|
|
last if $found > 1 and $inlist < 2; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
elsif (/^=item/) { |
282
|
0
|
0
|
0
|
|
|
|
last if $found > 1 and $inlist < 2; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
elsif ($found and /^X<[^>]+>/) { |
285
|
0
|
|
|
|
|
|
push @related, m/X<([^>]+)>/g; |
286
|
|
|
|
|
|
|
} |
287
|
0
|
0
|
|
|
|
|
next unless $found; |
288
|
0
|
0
|
|
|
|
|
if (/^=over/) { |
|
|
0
|
|
|
|
|
|
289
|
0
|
|
|
|
|
|
++$inlist; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
elsif (/^=back/) { |
292
|
0
|
|
|
|
|
|
--$inlist; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
# TWEAKED: to decode |
295
|
0
|
|
|
|
|
|
push @$pod, decode($encoding, $_); |
296
|
0
|
0
|
|
|
|
|
++$found if /^\w/; # found descriptive text |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
0
|
0
|
|
|
|
|
if( !@$pod ){ |
300
|
0
|
|
|
|
|
|
$self->search_perlop( $found_things, $pod ); |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
0
|
0
|
|
|
|
|
if (!@$pod) { |
304
|
0
|
|
|
|
|
|
CORE::die( sprintf |
305
|
|
|
|
|
|
|
"No documentation for perl function `%s' found\n", |
306
|
|
|
|
|
|
|
$self->opt_f ) |
307
|
|
|
|
|
|
|
; |
308
|
|
|
|
|
|
|
} |
309
|
0
|
0
|
|
|
|
|
close PFUNC or $self->die( "Can't open $perlfunc: $!" ); |
310
|
|
|
|
|
|
|
|
311
|
0
|
|
|
|
|
|
return; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
sub search_perlvar { |
315
|
0
|
|
|
0
|
1
|
|
my ($self, $found_things, $pod) = @_; |
316
|
|
|
|
|
|
|
|
317
|
0
|
|
|
|
|
|
my $opt = $self->opt_v; |
318
|
|
|
|
|
|
|
|
319
|
0
|
0
|
|
|
|
|
if ( $opt !~ /^ (?: [\@\%\$]\S+ | [A-Z]\w* ) $/x ) { |
320
|
0
|
|
|
|
|
|
CORE::die( "'$opt' does not look like a Perl variable\n" ); |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
0
|
|
|
|
|
|
Pod::Perldoc::DEBUG > 2 and print "Search: @$found_things\n"; |
324
|
|
|
|
|
|
|
|
325
|
0
|
|
|
|
|
|
my $perlvar = shift @$found_things; |
326
|
0
|
0
|
|
|
|
|
open(PVAR, "<", $perlvar) # "Funk is its own reward" |
327
|
|
|
|
|
|
|
or $self->die("Can't open $perlvar: $!"); |
328
|
|
|
|
|
|
|
|
329
|
0
|
0
|
0
|
|
|
|
if ( $opt ne '$0' && $opt =~ /^\$\d+$/ ) { # handle $1, $2, ..., $9 |
330
|
0
|
|
|
|
|
|
$opt = '$>'; |
331
|
|
|
|
|
|
|
} |
332
|
0
|
|
|
|
|
|
my $search_re = quotemeta($opt); |
333
|
|
|
|
|
|
|
|
334
|
0
|
|
|
|
|
|
Pod::Perldoc::DEBUG > 2 and |
335
|
|
|
|
|
|
|
print "Going to perlvar-scan for $search_re in $perlvar\n"; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
# Skip introduction |
338
|
0
|
|
|
|
|
|
local $_; |
339
|
|
|
|
|
|
|
# TWEAKED: to find encoding |
340
|
0
|
|
|
|
|
|
my $encoding = 'utf-8'; |
341
|
0
|
|
|
|
|
|
while () { |
342
|
0
|
0
|
|
|
|
|
if (/^=encoding\s+(\S+)/) { |
343
|
0
|
|
|
|
|
|
$encoding = $1; |
344
|
|
|
|
|
|
|
} |
345
|
0
|
0
|
|
|
|
|
last if /^=over 8/; |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
# Look for our variable |
349
|
0
|
|
|
|
|
|
my $found = 0; |
350
|
0
|
|
|
|
|
|
my $inheader = 1; |
351
|
0
|
|
|
|
|
|
my $inlist = 0; |
352
|
0
|
|
|
|
|
|
while () { # "The Mothership Connection is here!" |
353
|
0
|
0
|
|
|
|
|
last if /^=head2 Error Indicators/; |
354
|
|
|
|
|
|
|
# \b at the end of $` and friends borks things! |
355
|
0
|
0
|
|
|
|
|
if ( m/^=item\s+$search_re\s/ ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
356
|
0
|
|
|
|
|
|
$found = 1; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
elsif (/^=item/) { |
359
|
0
|
0
|
0
|
|
|
|
last if $found && !$inheader && !$inlist; |
|
|
|
0
|
|
|
|
|
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
elsif (!/^\s+$/) { # not a blank line |
362
|
0
|
0
|
|
|
|
|
if ( $found ) { |
363
|
0
|
|
|
|
|
|
$inheader = 0; # don't accept more =item (unless inlist) |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
else { |
366
|
0
|
|
|
|
|
|
@$pod = (); # reset |
367
|
0
|
|
|
|
|
|
$inheader = 1; # start over |
368
|
0
|
|
|
|
|
|
next; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
0
|
0
|
|
|
|
|
if (/^=over/) { |
|
|
0
|
|
|
|
|
|
373
|
0
|
|
|
|
|
|
++$inlist; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
elsif (/^=back/) { |
376
|
0
|
0
|
0
|
|
|
|
last if $found && !$inheader && !$inlist; |
|
|
|
0
|
|
|
|
|
377
|
0
|
|
|
|
|
|
--$inlist; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
# TWEAKED: to decode |
380
|
0
|
|
|
|
|
|
push @$pod, decode($encoding, $_); |
381
|
|
|
|
|
|
|
# ++$found if /^\w/; # found descriptive text |
382
|
|
|
|
|
|
|
} |
383
|
0
|
0
|
|
|
|
|
@$pod = () unless $found; |
384
|
0
|
0
|
|
|
|
|
if (!@$pod) { |
385
|
0
|
|
|
|
|
|
CORE::die( "No documentation for perl variable '$opt' found\n" ); |
386
|
|
|
|
|
|
|
} |
387
|
0
|
0
|
|
|
|
|
close PVAR or $self->die( "Can't open $perlvar: $!" ); |
388
|
|
|
|
|
|
|
|
389
|
0
|
|
|
|
|
|
return; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
sub search_perlfaqs { |
393
|
0
|
|
|
0
|
1
|
|
my ($self, $found_things, $pod) = @_; |
394
|
|
|
|
|
|
|
|
395
|
0
|
|
|
|
|
|
my $found = 0; |
396
|
0
|
|
|
|
|
|
my %found_in; |
397
|
0
|
|
|
|
|
|
my $search_key = $self->opt_q; |
398
|
|
|
|
|
|
|
|
399
|
0
|
0
|
|
|
|
|
my $rx = eval { qr/$search_key/ } |
|
0
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
or $self->die( <
|
401
|
|
|
|
|
|
|
Invalid regular expression '$search_key' given as -q pattern: |
402
|
|
|
|
|
|
|
$@ |
403
|
|
|
|
|
|
|
Did you mean \\Q$search_key ? |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
EOD |
406
|
|
|
|
|
|
|
|
407
|
0
|
|
|
|
|
|
local $_; |
408
|
0
|
|
|
|
|
|
foreach my $file (@$found_things) { |
409
|
0
|
0
|
|
|
|
|
$self->die( "invalid file spec: $!" ) if $file =~ /[<>|]/; |
410
|
0
|
0
|
|
|
|
|
open(INFAQ, "<", $file) # XXX 5.6ism |
411
|
|
|
|
|
|
|
or $self->die( "Can't read-open $file: $!\nAborting" ); |
412
|
|
|
|
|
|
|
# TWEAKED: to find encoding |
413
|
0
|
|
|
|
|
|
my $encoding = 'utf-8'; |
414
|
0
|
|
|
|
|
|
while () { |
415
|
0
|
0
|
|
|
|
|
if (/^=encoding\s+(\S+)/) { |
416
|
0
|
|
|
|
|
|
$encoding = $1; |
417
|
|
|
|
|
|
|
} |
418
|
0
|
0
|
|
|
|
|
if ( m/^=head2\s+.*(?:$search_key)/i ) { |
|
|
0
|
|
|
|
|
|
419
|
0
|
|
|
|
|
|
$found = 1; |
420
|
0
|
0
|
|
|
|
|
push @$pod, "=head1 Found in $file\n\n" unless $found_in{$file}++; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
elsif (/^=head[12]/) { |
423
|
0
|
|
|
|
|
|
$found = 0; |
424
|
|
|
|
|
|
|
} |
425
|
0
|
0
|
|
|
|
|
next unless $found; |
426
|
|
|
|
|
|
|
# TWEAKED: to decode |
427
|
0
|
|
|
|
|
|
push @$pod, decode($encoding, $_); |
428
|
|
|
|
|
|
|
} |
429
|
0
|
|
|
|
|
|
close(INFAQ); |
430
|
|
|
|
|
|
|
} |
431
|
0
|
0
|
|
|
|
|
CORE::die("No documentation for perl FAQ keyword `$search_key' found\n") |
432
|
|
|
|
|
|
|
unless @$pod; |
433
|
|
|
|
|
|
|
|
434
|
0
|
0
|
|
|
|
|
if ( $self->opt_l ) { |
435
|
0
|
|
|
|
|
|
CORE::die((join "\n", keys %found_in) . "\n"); |
436
|
|
|
|
|
|
|
} |
437
|
0
|
|
|
|
|
|
return; |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
sub search_perlapi { |
441
|
0
|
|
|
0
|
1
|
|
my($self, $found_things, $pod) = @_; |
442
|
|
|
|
|
|
|
|
443
|
0
|
|
|
|
|
|
Pod::Perldoc::DEBUG > 2 and print "Search: @$found_things\n"; |
444
|
|
|
|
|
|
|
|
445
|
0
|
|
|
|
|
|
my $perlapi = shift @$found_things; |
446
|
0
|
0
|
|
|
|
|
open(PAPI, "<", $perlapi) # "Funk is its own reward" |
447
|
|
|
|
|
|
|
or $self->die("Can't open $perlapi: $!"); |
448
|
|
|
|
|
|
|
|
449
|
0
|
|
|
|
|
|
my $search_re = quotemeta($self->opt_a); |
450
|
|
|
|
|
|
|
|
451
|
0
|
|
|
|
|
|
Pod::Perldoc::DEBUG > 2 and |
452
|
|
|
|
|
|
|
print "Going to perlapi-scan for $search_re in $perlapi\n"; |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
# Check available translator or backup to default (english) |
455
|
0
|
0
|
0
|
|
|
|
if ( $self->opt_L && defined $self->{'translators'}->[0] ) { |
456
|
0
|
|
|
|
|
|
my $tr = $self->{'translators'}->[0]; |
457
|
0
|
0
|
|
|
|
|
if ( $] < 5.008 ) { |
458
|
0
|
|
|
|
|
|
$self->aside("Your old perl doesn't really have proper unicode support."); |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
else { |
461
|
0
|
|
|
|
|
|
binmode(PAPI, ":utf8"); |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
|
465
|
0
|
|
|
|
|
|
local $_; |
466
|
|
|
|
|
|
|
# TWEAKED: to find encoding |
467
|
0
|
|
|
|
|
|
my $encoding = 'utf-8'; |
468
|
0
|
|
|
|
|
|
while () { |
469
|
0
|
0
|
|
|
|
|
if (/^=encoding\s+(\S+)/) { |
470
|
0
|
|
|
|
|
|
$encoding = $1; |
471
|
|
|
|
|
|
|
} |
472
|
0
|
0
|
|
|
|
|
last if /^=over 8/; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
# Look for our function |
476
|
0
|
|
|
|
|
|
my $found = 0; |
477
|
0
|
|
|
|
|
|
my $inlist = 0; |
478
|
|
|
|
|
|
|
|
479
|
0
|
|
|
|
|
|
my @related; |
480
|
|
|
|
|
|
|
my $related_re; |
481
|
0
|
|
|
|
|
|
while () { # "The Mothership Connection is here!" |
482
|
0
|
0
|
0
|
|
|
|
if ( m/^=item\s+$search_re\b/ ) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
483
|
0
|
|
|
|
|
|
$found = 1; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
elsif (@related > 1 and /^=item/) { |
486
|
0
|
|
0
|
|
|
|
$related_re ||= join "|", @related; |
487
|
0
|
0
|
|
|
|
|
if (m/^=item\s+(?:$related_re)\b/) { |
488
|
0
|
|
|
|
|
|
$found = 1; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
else { |
491
|
0
|
|
|
|
|
|
last; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
elsif (/^=item/) { |
495
|
0
|
0
|
0
|
|
|
|
last if $found > 1 and not $inlist; |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
elsif ($found and /^X<[^>]+>/) { |
498
|
0
|
|
|
|
|
|
push @related, m/X<([^>]+)>/g; |
499
|
|
|
|
|
|
|
} |
500
|
0
|
0
|
|
|
|
|
next unless $found; |
501
|
0
|
0
|
|
|
|
|
if (/^=over/) { |
|
|
0
|
|
|
|
|
|
502
|
0
|
|
|
|
|
|
++$inlist; |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
elsif (/^=back/) { |
505
|
0
|
0
|
0
|
|
|
|
last if $found > 1 and not $inlist; |
506
|
0
|
|
|
|
|
|
--$inlist; |
507
|
|
|
|
|
|
|
} |
508
|
0
|
|
|
|
|
|
push @$pod, decode($encoding, $_); |
509
|
0
|
0
|
|
|
|
|
++$found if /^\w/; # found descriptive text |
510
|
|
|
|
|
|
|
} |
511
|
|
|
|
|
|
|
|
512
|
0
|
0
|
|
|
|
|
if (!@$pod) { |
513
|
0
|
|
|
|
|
|
CORE::die( sprintf |
514
|
|
|
|
|
|
|
"No documentation for perl api function '%s' found\n", |
515
|
|
|
|
|
|
|
$self->opt_a ) |
516
|
|
|
|
|
|
|
; |
517
|
|
|
|
|
|
|
} |
518
|
0
|
0
|
|
|
|
|
close PAPI or $self->die( "Can't open $perlapi: $!" ); |
519
|
|
|
|
|
|
|
|
520
|
0
|
|
|
|
|
|
return; |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
# TWEAKED: translation and encoding |
524
|
|
|
|
|
|
|
sub usage { |
525
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
526
|
0
|
0
|
|
|
|
|
$self->warn( "@_\n" ) if @_; |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
# Erase evidence of previous errors (if any), so exit status is simple. |
529
|
0
|
|
|
|
|
|
$! = 0; |
530
|
|
|
|
|
|
|
|
531
|
0
|
|
|
|
|
|
my $usage = <<"EOF"; |
532
|
|
|
|
|
|
|
perldoc [options] PageName|ModuleName|ProgramName|URL... |
533
|
|
|
|
|
|
|
perldoc [options] -f BuiltinFunction |
534
|
|
|
|
|
|
|
perldoc [options] -q FAQRegex |
535
|
|
|
|
|
|
|
perldoc [options] -v PerlVariable |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
オプション: |
538
|
|
|
|
|
|
|
-h このヘルプを表示する |
539
|
|
|
|
|
|
|
-V バージョンを表示する |
540
|
|
|
|
|
|
|
-r 再帰検索 (時間がかかります) |
541
|
|
|
|
|
|
|
-i 大文字小文字を無視する |
542
|
|
|
|
|
|
|
-t pod2manとnroffではなくpod2textを使って表示(デフォルト) |
543
|
|
|
|
|
|
|
-u 整形前のPODを表示する |
544
|
|
|
|
|
|
|
-m 指定したモジュールのコードも含めて表示する |
545
|
|
|
|
|
|
|
-n nroffのかわりを指定する |
546
|
|
|
|
|
|
|
-l モジュールのファイル名を表示する |
547
|
|
|
|
|
|
|
-F 引数はモジュール名ではなくファイル名である |
548
|
|
|
|
|
|
|
-D デバッグメッセージを表示する |
549
|
|
|
|
|
|
|
-T ページャを通さずに画面に出力する |
550
|
|
|
|
|
|
|
-d 保存するファイル名 |
551
|
|
|
|
|
|
|
-o 出力フォーマット名 |
552
|
|
|
|
|
|
|
-M フォーマット用のモジュール名(FormatterModuleNameToUse) |
553
|
|
|
|
|
|
|
-w フォーマット用のオプション:値(formatter_option:option_value) |
554
|
|
|
|
|
|
|
-L 国別コード。(あれば)翻訳を表示します |
555
|
|
|
|
|
|
|
-X あれば索引を利用する (pod.idxを探します) |
556
|
|
|
|
|
|
|
-J perldoc.jpの日本語訳も検索 |
557
|
|
|
|
|
|
|
-q perlfaq[1-9]の質問を検索 |
558
|
|
|
|
|
|
|
-f Perlの組み込み関数を検索 |
559
|
|
|
|
|
|
|
-a Perl APIを検索 |
560
|
|
|
|
|
|
|
-v Perlの定義済み変数を検索 |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
PageName|ModuleName|ProgramName|URL... |
563
|
|
|
|
|
|
|
表示したいドキュメント名です。「perlfunc」のようなページ名、 |
564
|
|
|
|
|
|
|
モジュール名(「Term::Info」または「Term/Info」)、「perldoc」 |
565
|
|
|
|
|
|
|
のようなプログラム名、http(s)で始まるURLを指定できます。 |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
BuiltinFunction |
568
|
|
|
|
|
|
|
Perlの関数名です。「perlfunc」ないし「perlop」からドキュメント |
569
|
|
|
|
|
|
|
を抽出します。 |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
FAQRegex |
572
|
|
|
|
|
|
|
正規表現です。perlfaq[1-9]を検索してマッチした質問を抽出します。 |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
PERLDOC環境変数で指定したスイッチはコマンドライン引数の前に適用されます。 |
575
|
|
|
|
|
|
|
PODの索引には(あれば)ファイル名の一覧が(1行に1つ)含まれています。 |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
[PerldocJp v$Pod::PerldocJp::VERSION based on Perldoc v$Pod::Perldoc::VERSION] |
578
|
|
|
|
|
|
|
EOF |
579
|
|
|
|
|
|
|
|
580
|
0
|
|
|
|
|
|
CORE::die encode($term_encoding => $usage); |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
sub usage_brief { |
584
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
585
|
0
|
|
|
|
|
|
my $program_name = $self->program_name; |
586
|
|
|
|
|
|
|
|
587
|
0
|
|
|
|
|
|
my $usage =<<"EOUSAGE"; |
588
|
|
|
|
|
|
|
使い方: $program_name [-hVriDtumFXlTJ] [-n nroffer_program] |
589
|
|
|
|
|
|
|
[-d output_filename] [-o output_format] [-M FormatterModule] |
590
|
|
|
|
|
|
|
[-w formatter_option:option_value] [-L translation_code] |
591
|
|
|
|
|
|
|
PageName|ModuleName|ProgramName |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
Examples: |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
$program_name -f PerlFunc |
596
|
|
|
|
|
|
|
$program_name -q FAQKeywords |
597
|
|
|
|
|
|
|
$program_name -v PerlVar |
598
|
|
|
|
|
|
|
$program_name -a PerlAPI |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
-hオプションをつけるともう少し詳しいヘルプが表示されます。 |
601
|
|
|
|
|
|
|
詳細は"perldocjp perldocjp"をご覧ください。 |
602
|
|
|
|
|
|
|
[PerldocJp v$Pod::PerldocJp::VERSION based on Perldoc v$Pod::Perldoc::VERSION] |
603
|
|
|
|
|
|
|
EOUSAGE |
604
|
|
|
|
|
|
|
|
605
|
0
|
|
|
|
|
|
CORE::die encode($term_encoding => $usage); |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
1; |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
__END__ |