blib/lib/Math/NumSeq/OEIS/File.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 92 | 388 | 23.7 |
branch | 21 | 184 | 11.4 |
condition | 9 | 85 | 10.5 |
subroutine | 21 | 40 | 52.5 |
pod | 8 | 10 | 80.0 |
total | 151 | 707 | 21.3 |
line | stmt | bran | cond | sub | pod | time | code | ||
---|---|---|---|---|---|---|---|---|---|
1 | # Copyright 2011, 2012, 2013, 2014 Kevin Ryde | ||||||||
2 | |||||||||
3 | # This file is part of Math-NumSeq. | ||||||||
4 | # | ||||||||
5 | # Math-NumSeq is free software; you can redistribute it and/or modify | ||||||||
6 | # it under the terms of the GNU General Public License as published by the | ||||||||
7 | # Free Software Foundation; either version 3, or (at your option) any later | ||||||||
8 | # version. | ||||||||
9 | # | ||||||||
10 | # Math-NumSeq is distributed in the hope that it will be useful, but | ||||||||
11 | # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY | ||||||||
12 | # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | ||||||||
13 | # for more details. | ||||||||
14 | # | ||||||||
15 | # You should have received a copy of the GNU General Public License along | ||||||||
16 | # with Math-NumSeq. If not, see |
||||||||
17 | |||||||||
18 | |||||||||
19 | # http://oeis.org/wiki/Clear-cut_examples_of_keywords | ||||||||
20 | # | ||||||||
21 | # ENHANCE-ME: share most of the a-file/b-file reading with Math::NumSeq::File | ||||||||
22 | |||||||||
23 | package Math::NumSeq::OEIS::File; | ||||||||
24 | 2 | 2 | 6247 | use 5.004; | |||||
2 | 4 | ||||||||
25 | 2 | 2 | 6 | use strict; | |||||
2 | 1 | ||||||||
2 | 31 | ||||||||
26 | 2 | 2 | 6 | use Carp; | |||||
2 | 2 | ||||||||
2 | 84 | ||||||||
27 | 2 | 2 | 786 | use POSIX (); | |||||
2 | 9141 | ||||||||
2 | 41 | ||||||||
28 | 2 | 2 | 9 | use File::Spec; | |||||
2 | 3 | ||||||||
2 | 31 | ||||||||
29 | 2 | 2 | 767 | use Symbol 'gensym'; | |||||
2 | 1290 | ||||||||
2 | 99 | ||||||||
30 | |||||||||
31 | 2 | 2 | 9 | use vars '$VERSION','@ISA'; | |||||
2 | 2 | ||||||||
2 | 89 | ||||||||
32 | $VERSION = 72; | ||||||||
33 | |||||||||
34 | 2 | 2 | 349 | use Math::NumSeq; | |||||
2 | 2 | ||||||||
2 | 67 | ||||||||
35 | @ISA = ('Math::NumSeq'); | ||||||||
36 | *_to_bigint = \&Math::NumSeq::_to_bigint; | ||||||||
37 | |||||||||
38 | 2 | 2 | 9 | use vars '$VERSION'; | |||||
2 | 2 | ||||||||
2 | 113 | ||||||||
39 | $VERSION = 72; | ||||||||
40 | |||||||||
41 | 2 | 2 | 9 | eval q{use Scalar::Util 'weaken'; 1} | |||||
2 | 2 | ||||||||
2 | 99 | ||||||||
42 | || eval q{sub weaken { $_[0] = undef }; 1 } | ||||||||
43 | || die "Oops, error making a weaken() fallback: $@"; | ||||||||
44 | |||||||||
45 | # uncomment this to run the ### lines | ||||||||
46 | # use Smart::Comments; | ||||||||
47 | |||||||||
48 | |||||||||
49 | # use constant name => Math::NumSeq::__('OEIS File'); | ||||||||
50 | 2 | 2 | 354 | use Math::NumSeq::OEIS; | |||||
2 | 2 | ||||||||
2 | 88 | ||||||||
51 | *parameter_info_array = \&Math::NumSeq::OEIS::parameter_info_array; | ||||||||
52 | |||||||||
53 | use constant::defer _HAVE_ENCODE => sub { | ||||||||
54 | 0 | 0 | 0 | eval { require Encode; 1 } || 0; | |||||
0 | 0 | ||||||||
0 | 0 | ||||||||
55 | 2 | 2 | 7 | }; | |||||
2 | 2 | ||||||||
2 | 13 | ||||||||
56 | |||||||||
57 | sub description { | ||||||||
58 | 0 | 0 | 1 | 0 | my ($class_or_self) = @_; | ||||
59 | 0 | 0 | 0 | 0 | if (ref $class_or_self && defined $class_or_self->{'description'}) { | ||||
60 | # instance | ||||||||
61 | 0 | 0 | return $class_or_self->{'description'}; | ||||||
62 | } else { | ||||||||
63 | # class | ||||||||
64 | 0 | 0 | return Math::NumSeq::__('OEIS sequence from file.'); | ||||||
65 | } | ||||||||
66 | } | ||||||||
67 | |||||||||
68 | sub values_min { | ||||||||
69 | 0 | 0 | 1 | 0 | my ($self) = @_; | ||||
70 | ### OEIS-File values_min() ... | ||||||||
71 | 0 | 0 | return _analyze($self)->{'values_min'}; | ||||||
72 | } | ||||||||
73 | sub values_max { | ||||||||
74 | 0 | 0 | 1 | 0 | my ($self) = @_; | ||||
75 | ### OEIS-File values_max() ... | ||||||||
76 | 0 | 0 | return _analyze($self)->{'values_max'}; | ||||||
77 | } | ||||||||
78 | |||||||||
79 | my %analyze_characteristics = (increasing => 1, | ||||||||
80 | increasing_from_i => 1, | ||||||||
81 | non_decreasing => 1, | ||||||||
82 | non_decreasing_from_i => 1, | ||||||||
83 | smaller => 1, | ||||||||
84 | ); | ||||||||
85 | sub characteristic { | ||||||||
86 | 0 | 0 | 1 | 0 | my ($self, $key) = @_; | ||||
87 | 0 | 0 | 0 | if ($analyze_characteristics{$key}) { | |||||
88 | 0 | 0 | _analyze($self); | ||||||
89 | } | ||||||||
90 | 0 | 0 | return shift->SUPER::characteristic(@_); | ||||||
91 | } | ||||||||
92 | |||||||||
93 | sub oeis_dir { | ||||||||
94 | 246 | 246 | 0 | 1147 | require File::HomeDir; | ||||
95 | 246 | 4123 | return File::Spec->catfile (File::HomeDir->my_home, 'OEIS'); | ||||||
96 | } | ||||||||
97 | sub anum_to_bfile { | ||||||||
98 | 0 | 0 | 0 | 0 | my ($anum, $prefix) = @_; | ||||
99 | 0 | 0 | 0 | $prefix ||= 'b'; | |||||
100 | 0 | 0 | $anum =~ s/^A/$prefix/; | ||||||
101 | 0 | 0 | return "$anum.txt"; | ||||||
102 | } | ||||||||
103 | |||||||||
104 | #------------------------------------------------------------------------------ | ||||||||
105 | # Keep track of all instances which exist and on an ithread CLONE re-open | ||||||||
106 | # any filehandles in the instances, so they have their own independent file | ||||||||
107 | # positions in the new thread. | ||||||||
108 | |||||||||
109 | my %instances; | ||||||||
110 | sub DESTROY { | ||||||||
111 | 65 | 65 | 74 | my ($self) = @_; | |||||
112 | 65 | 303 | delete $instances{$self+0}; | ||||||
113 | } | ||||||||
114 | sub CLONE { | ||||||||
115 | 0 | 0 | 0 | my ($class) = @_; | |||||
116 | 0 | 0 | foreach my $self (values %instances) { | ||||||
117 | 0 | 0 | 0 | next unless $self; | |||||
118 | 0 | 0 | 0 | next unless $self->{'fh'}; | |||||
119 | 0 | 0 | my $pos = _tell($self); | ||||||
120 | 0 | 0 | my $fh = gensym; | ||||||
121 | 0 | 0 | 0 | if (open $fh, "< $self->{'filename'}") { | |||||
122 | 0 | 0 | $self->{'fh'} = $fh; | ||||||
123 | 0 | 0 | _seek ($self, $pos); | ||||||
124 | } else { | ||||||||
125 | 0 | 0 | delete $self->{'fh'}; | ||||||
126 | 0 | 0 | delete $self->{'filename'}; | ||||||
127 | } | ||||||||
128 | } | ||||||||
129 | } | ||||||||
130 | |||||||||
131 | #------------------------------------------------------------------------------ | ||||||||
132 | |||||||||
133 | # The length in decimal digits of the biggest value which fits in a plain | ||||||||
134 | # Perl integer. For example on a 32-bit system this is 9 since 9 digit | ||||||||
135 | # numbers such as "999_999_999" are the biggest which fit a signed IV | ||||||||
136 | # (+2^31). | ||||||||
137 | # | ||||||||
138 | # The IV size is probed rather than using ~0 since under "perl -Minteger" | ||||||||
139 | # have ~0 as -1 rather than the biggest UV ... except "use integer" is not | ||||||||
140 | # normally global. | ||||||||
141 | # | ||||||||
142 | # The NV size is applied to the limit too since not sure should trust values | ||||||||
143 | # to stay in IV or UV. This means on a 64-bit integer with 53-bit NV | ||||||||
144 | # "double" the limit is 53-bits. | ||||||||
145 | # | ||||||||
146 | 2 | 4 | use constant 1.02 _MAX_DIGIT_LENGTH => do { | ||||||
147 | ### ~0 is: ~0 | ||||||||
148 | |||||||||
149 | 2 | 13 | my $iv = 0; | ||||||
150 | 2 | 7 | for (1 .. 256) { | ||||||
151 | 130 | 86 | my $new = ($iv << 1) | 1; | ||||||
152 | 130 | 100 | 66 | 296 | unless ($new > $iv && ($new & 1) == 1) { | ||||
153 | 2 | 4 | last; | ||||||
154 | } | ||||||||
155 | 128 | 83 | $iv = $new; | ||||||
156 | } | ||||||||
157 | ### $iv | ||||||||
158 | |||||||||
159 | 2 | 33 | require POSIX; | ||||||
160 | 2 | 3 | my $nv = POSIX::FLT_RADIX() ** (POSIX::DBL_MANT_DIG()-5); | ||||||
161 | ### $nv | ||||||||
162 | |||||||||
163 | 2 | 4 | my $iv_len = length($iv) - 1; | ||||||
164 | 2 | 12 | my $nv_len = length($nv) - 1; | ||||||
165 | 2 | 50 | 5424 | ($iv_len < $nv_len ? $iv_len : $nv_len) # smaller of the two lengths; | |||||
166 | 2 | 2 | 853 | }; | |||||
2 | 30 | ||||||||
167 | ### _MAX_DIGIT_LENGTH: _MAX_DIGIT_LENGTH() | ||||||||
168 | |||||||||
169 | |||||||||
170 | #------------------------------------------------------------------------------ | ||||||||
171 | |||||||||
172 | # special case a000000.txt files to exclude | ||||||||
173 | # | ||||||||
174 | my %afile_exclude | ||||||||
175 | = ( | ||||||||
176 | # a003849.txt has replication level words rather than the individual | ||||||||
177 | # sequence values. | ||||||||
178 | 'a003849.txt' => 1, | ||||||||
179 | |||||||||
180 | # a027750.txt is unflattened divisors as lists. | ||||||||
181 | # Its first line is a correct looking "1 1" so _afile_is_good() doesn't | ||||||||
182 | # notice. | ||||||||
183 | 'a027750.txt' => 1, | ||||||||
184 | ); | ||||||||
185 | |||||||||
186 | |||||||||
187 | # Fields: | ||||||||
188 | # fh File handle ref, if reading B-file or A-file | ||||||||
189 | # | ||||||||
190 | # next_seek File pos to seek $fh for next() to read from. | ||||||||
191 | # ith() sets this when it moves the file position. | ||||||||
192 | # | ||||||||
193 | # array Arrayref of values if using .internal or .html. | ||||||||
194 | # array_pos Index 0,1,2,... of next value of $array to return by next(). | ||||||||
195 | # | ||||||||
196 | # i Next $i for next() to return. | ||||||||
197 | # When reading a file this is ignored, use the file i instead. | ||||||||
198 | |||||||||
199 | sub new { | ||||||||
200 | ### OEIS-File new() ... | ||||||||
201 | 65 | 65 | 1 | 6722 | my $self = shift->SUPER::new(@_); | ||||
202 | |||||||||
203 | 65 | 98 | delete $self->{'next_seek'}; # no initial seek | ||||||
204 | 65 | 99 | $self->{'characteristic'}->{'integer'} = 1; | ||||||
205 | |||||||||
206 | 65 | 55 | my $anum = $self->{'anum'}; | ||||||
207 | 65 | 207 | (my $num = $anum) =~ s/^A//; | ||||||
208 | 65 | 158 | foreach my $basefile ("a$num.txt", | ||||||
209 | "b$num.txt") { | ||||||||
210 | 130 | 100 | 188 | next if $afile_exclude{$basefile}; | |||||
211 | |||||||||
212 | 120 | 100 | 100 | 395 | next if $self->{'_dont_use_afile'} && $basefile =~ /^a/; | ||||
213 | 76 | 100 | 66 | 204 | next if $self->{'_dont_use_bfile'} && $basefile =~ /^b/; | ||||
214 | |||||||||
215 | 37 | 49 | my $filename = File::Spec->catfile (oeis_dir(), $basefile); | ||||||
216 | ### $filename | ||||||||
217 | 37 | 1133 | my $fh = gensym(); | ||||||
218 | 37 | 50 | 669 | if (! open $fh, "< $filename") { | |||||
219 | ### cannot open: $! | ||||||||
220 | 37 | 108 | next; | ||||||
221 | } | ||||||||
222 | |||||||||
223 | 0 | 0 | $self->{'filename'} = $filename; # the B-file or A-file name | ||||||
224 | 0 | 0 | $self->{'fh'} = $fh; | ||||||
225 | 0 | 0 | 0 | if (! _afile_is_good($self)) { | |||||
226 | ### this afile not good ... | ||||||||
227 | 0 | 0 | close delete $self->{'fh'}; | ||||||
228 | 0 | 0 | delete $self->{'filename'}; | ||||||
229 | 0 | 0 | next; | ||||||
230 | } | ||||||||
231 | 0 | 0 | $self->{'fh_i'} = $self->i_start; # at first entry | ||||||
232 | |||||||||
233 | ### opened: $fh | ||||||||
234 | 0 | 0 | last; | ||||||
235 | } | ||||||||
236 | |||||||||
237 | 65 | 33 | 104 | my $have_info = (_read_internal_txt($self, $anum) | |||||
238 | || _read_internal_html($self, $anum) | ||||||||
239 | || _read_html($self, $anum)); | ||||||||
240 | |||||||||
241 | 65 | 50 | 33 | 170 | if (! $have_info && ! $self->{'fh'}) { | ||||
242 | 65 | 7489 | croak 'OEIS file(s) not found for A-number "',$anum,'"'; | ||||||
243 | } | ||||||||
244 | |||||||||
245 | 0 | 0 | weaken($instances{$self+0} = $self); | ||||||
246 | 0 | 0 | return $self; | ||||||
247 | } | ||||||||
248 | |||||||||
249 | sub _analyze { | ||||||||
250 | 0 | 0 | 0 | my ($self) = @_; | |||||
251 | |||||||||
252 | 0 | 0 | 0 | if ($self->{'analyze_done'}) { | |||||
253 | 0 | 0 | return $self; | ||||||
254 | } | ||||||||
255 | 0 | 0 | $self->{'analyze_done'} = 1; | ||||||
256 | |||||||||
257 | ### _analyze() ... | ||||||||
258 | |||||||||
259 | 0 | 0 | my $i_start = $self->i_start; | ||||||
260 | 0 | 0 | my ($i, $value); | ||||||
261 | 0 | 0 | my ($prev_i, $prev_value); | ||||||
262 | |||||||||
263 | 0 | 0 | my $values_min; | ||||||
264 | 0 | 0 | my $values_max; | ||||||
265 | 0 | 0 | my $increasing_from_i = $i_start; | ||||||
266 | 0 | 0 | my $non_decreasing_from_i = $i_start; | ||||||
267 | 0 | 0 | my $strictly_smaller_count = 0; | ||||||
268 | 0 | 0 | my $smaller_count = 0; | ||||||
269 | 0 | 0 | my $total_count = 0; | ||||||
270 | |||||||||
271 | my $analyze = sub { | ||||||||
272 | ### $prev_value | ||||||||
273 | ### $value | ||||||||
274 | 0 | 0 | 0 | 0 | 0 | if (! defined $values_min || $value < $values_min) { | |||
275 | 0 | 0 | $values_min = $value; | ||||||
276 | } | ||||||||
277 | 0 | 0 | 0 | 0 | if (! defined $values_max || $value > $values_max) { | ||||
278 | 0 | 0 | $values_max = $value; | ||||||
279 | } | ||||||||
280 | |||||||||
281 | 0 | 0 | 0 | if (defined $prev_value) { | |||||
282 | 0 | 0 | my $cmp = ($value <=> $prev_value); | ||||||
283 | 0 | 0 | 0 | if ($cmp < 0) { | |||||
284 | # value < $prev_value | ||||||||
285 | 0 | 0 | $increasing_from_i = $i; | ||||||
286 | 0 | 0 | $non_decreasing_from_i = $i; | ||||||
287 | } | ||||||||
288 | 0 | 0 | 0 | if ($cmp <= 0) { | |||||
289 | # value <= $prev_value | ||||||||
290 | 0 | 0 | $increasing_from_i = $i; | ||||||
291 | } | ||||||||
292 | } | ||||||||
293 | |||||||||
294 | 0 | 0 | $total_count++; | ||||||
295 | 0 | 0 | $smaller_count += (abs($value) <= $i); | ||||||
296 | 0 | 0 | $strictly_smaller_count += ($value < $i); | ||||||
297 | |||||||||
298 | 0 | 0 | $prev_i = $value; | ||||||
299 | 0 | 0 | $prev_value = $value; | ||||||
300 | 0 | 0 | }; | ||||||
301 | |||||||||
302 | 0 | 0 | 0 | if (my $fh = $self->{'fh'}) { | |||||
303 | 0 | 0 | my $oldpos = _tell($self); | ||||||
304 | 0 | 0 | while (($i, $value) = _readline($self)) { | ||||||
305 | 0 | 0 | $analyze->($value); | ||||||
306 | 0 | 0 | 0 | last if $total_count > 200; | |||||
307 | } | ||||||||
308 | 0 | 0 | _seek ($self, $oldpos); | ||||||
309 | } else { | ||||||||
310 | 0 | 0 | $i = $i_start; | ||||||
311 | 0 | 0 | foreach (@{$self->{'array'}}) { | ||||||
0 | 0 | ||||||||
312 | 0 | 0 | $i++; | ||||||
313 | 0 | 0 | $value = $_; | ||||||
314 | 0 | 0 | $analyze->(); | ||||||
315 | } | ||||||||
316 | } | ||||||||
317 | |||||||||
318 | 0 | 0 | 0 | my $range_is_small = (defined $values_max | |||||
319 | && $values_max - $values_min <= 16); | ||||||||
320 | ### $range_is_small | ||||||||
321 | |||||||||
322 | # "full" means whole sequence in sample values | ||||||||
323 | # "sign" means negatives in sequence | ||||||||
324 | 0 | 0 | 0 | 0 | if (! defined $self->{'values_min'} | ||||
0 | |||||||||
325 | && ($range_is_small | ||||||||
326 | || $self->{'characteristic'}->{'OEIS_full'} | ||||||||
327 | || ! $self->{'characteristic'}->{'OEIS_sign'})) { | ||||||||
328 | ### set values_min: $values_min | ||||||||
329 | 0 | 0 | $self->{'values_min'} = $values_min; | ||||||
330 | } | ||||||||
331 | 0 | 0 | 0 | 0 | if (! defined $self->{'values_max'} | ||||
0 | |||||||||
332 | && ($range_is_small | ||||||||
333 | || $self->{'characteristic'}->{'OEIS_full'})) { | ||||||||
334 | ### set values_max: $values_max | ||||||||
335 | 0 | 0 | $self->{'values_max'} = $values_max; | ||||||
336 | } | ||||||||
337 | |||||||||
338 | 0 | 0 | 0 | $self->{'characteristic'}->{'smaller'} | |||||
339 | = ($total_count == 0 | ||||||||
340 | || ($smaller_count / $total_count >= .9 | ||||||||
341 | && $strictly_smaller_count > 0)); | ||||||||
342 | ### decide smaller: $self->{'characteristic'}->{'smaller'} | ||||||||
343 | |||||||||
344 | ### $increasing_from_i | ||||||||
345 | 0 | 0 | 0 | 0 | if (defined $prev_i && $increasing_from_i < $prev_i) { | ||||
346 | 0 | 0 | 0 | if ($increasing_from_i - $i_start < 20) { | |||||
347 | 0 | 0 | $self->{'characteristic'}->{'increasing_from_i'} = $increasing_from_i; | ||||||
348 | } | ||||||||
349 | 0 | 0 | 0 | if ($increasing_from_i == $i_start) { | |||||
350 | 0 | 0 | $self->{'characteristic'}->{'increasing'} = 1; | ||||||
351 | } | ||||||||
352 | } | ||||||||
353 | |||||||||
354 | ### $non_decreasing_from_i | ||||||||
355 | 0 | 0 | 0 | 0 | if (defined $prev_i && $non_decreasing_from_i < $prev_i) { | ||||
356 | 0 | 0 | 0 | if ($non_decreasing_from_i - $i_start < 20) { | |||||
357 | 0 | 0 | $self->{'characteristic'}->{'non_decreasing_from_i'} = $non_decreasing_from_i; | ||||||
358 | } | ||||||||
359 | 0 | 0 | 0 | if ($non_decreasing_from_i == $i_start) { | |||||
360 | 0 | 0 | $self->{'characteristic'}->{'non_decreasing'} = 1; | ||||||
361 | } | ||||||||
362 | } | ||||||||
363 | |||||||||
364 | 0 | 0 | return $self; | ||||||
365 | } | ||||||||
366 | |||||||||
367 | # # compare $x <=> $y but in strings in case they're bigger than IV or NV | ||||||||
368 | # # my $cmp = _value_cmp ($value, $prev_value); | ||||||||
369 | # sub _value_cmp { | ||||||||
370 | # my ($x, $y) = @_; | ||||||||
371 | # ### _value_cmp(): "$x $y" | ||||||||
372 | # ### cmp: $x cmp $y | ||||||||
373 | # | ||||||||
374 | # my $x_neg = substr($x,0,1) eq '-'; | ||||||||
375 | # my $y_neg = substr($y,0,1) eq '-'; | ||||||||
376 | # ### $x_neg | ||||||||
377 | # ### $y_neg | ||||||||
378 | # | ||||||||
379 | # return ($y_neg <=> $x_neg | ||||||||
380 | # || ($x_neg ? -1 : 1) * (length($x) <=> length($y) | ||||||||
381 | # || $x cmp $y)); | ||||||||
382 | # } | ||||||||
383 | |||||||||
384 | sub _seek { | ||||||||
385 | 0 | 0 | 0 | my ($self, $pos) = @_; | |||||
386 | 0 | 0 | 0 | seek ($self->{'fh'}, $pos, 0) | |||||
387 | or croak "Cannot seek $self->{'filename'}: $!"; | ||||||||
388 | } | ||||||||
389 | sub _tell { | ||||||||
390 | 0 | 0 | 0 | my ($self) = @_; | |||||
391 | 0 | 0 | my $pos = tell $self->{'fh'}; | ||||||
392 | 0 | 0 | 0 | if ($pos < 0) { | |||||
393 | 0 | 0 | croak "Cannot tell file position $self->{'filename'}: $!"; | ||||||
394 | } | ||||||||
395 | 0 | 0 | return $pos; | ||||||
396 | } | ||||||||
397 | |||||||||
398 | sub rewind { | ||||||||
399 | 65 | 65 | 1 | 60 | my ($self) = @_; | ||||
400 | ### OEIS-File rewind() ... | ||||||||
401 | |||||||||
402 | 65 | 110 | $self->{'i'} = $self->i_start; | ||||||
403 | 65 | 60 | $self->{'array_pos'} = 0; | ||||||
404 | 65 | 85 | $self->{'next_seek'} = 0; | ||||||
405 | } | ||||||||
406 | |||||||||
407 | sub next { | ||||||||
408 | 0 | 0 | 1 | 0 | my ($self) = @_; | ||||
409 | ### OEIS-File next(): "i=$self->{'i'}" | ||||||||
410 | |||||||||
411 | 0 | 0 | my $value; | ||||||
412 | 0 | 0 | 0 | if (my $fh = $self->{'fh'}) { | |||||
413 | ### from readline ... | ||||||||
414 | 0 | 0 | 0 | if (defined (my $pos = delete $self->{'next_seek'})) { | |||||
415 | ### seek to: $pos | ||||||||
416 | 0 | 0 | _seek($self, $pos); | ||||||
417 | } | ||||||||
418 | 0 | 0 | return _readline($self); | ||||||
419 | |||||||||
420 | } else { | ||||||||
421 | ### from array ... | ||||||||
422 | 0 | 0 | 0 | my ($value) = _array_value($self, $self->{'array_pos'}++) | |||||
423 | or return; | ||||||||
424 | 0 | 0 | return ($self->{'i'}++, $value); | ||||||
425 | } | ||||||||
426 | } | ||||||||
427 | |||||||||
428 | # Return $self->{'array'}->[$pos], or no values if $pos past end of array. | ||||||||
429 | # Array values are promoted to BigInt if necessary. | ||||||||
430 | sub _array_value { | ||||||||
431 | 0 | 0 | 0 | my ($self, $pos) = @_; | |||||
432 | ### _array_value(): $pos | ||||||||
433 | |||||||||
434 | 0 | 0 | my $array = $self->{'array'}; | ||||||
435 | 0 | 0 | 0 | if ($pos > $#$array) { | |||||
436 | ### past end of array ... | ||||||||
437 | 0 | 0 | return; | ||||||
438 | } | ||||||||
439 | 0 | 0 | my $value = $array->[$pos]; | ||||||
440 | |||||||||
441 | # large values as Math::BigInt | ||||||||
442 | # initially $array has strings, make bigint objects when required | ||||||||
443 | 0 | 0 | 0 | 0 | if (! ref $value && length($value) > _MAX_DIGIT_LENGTH) { | ||||
444 | 0 | 0 | $value = $array->[$pos] = _to_bigint($value); | ||||||
445 | } | ||||||||
446 | ### $value | ||||||||
447 | 0 | 0 | return $value; | ||||||
448 | } | ||||||||
449 | |||||||||
450 | # Read a line from an open B-file or A-file, return ($i,$value). | ||||||||
451 | # At EOF return empty (). | ||||||||
452 | # | ||||||||
453 | sub _readline { | ||||||||
454 | 0 | 0 | 0 | my ($self) = @_; | |||||
455 | 0 | 0 | my $fh = $self->{'fh'}; | ||||||
456 | 0 | 0 | while (defined (my $line = <$fh>)) { | ||||||
457 | 0 | 0 | chomp $line; | ||||||
458 | 0 | 0 | $line =~ tr/\r//d; # delete CR if CRLF line endings, eg. b009000.txt | ||||||
459 | ### $line | ||||||||
460 | |||||||||
461 | 0 | 0 | 0 | if ($line =~ /^\s*(#|$)/) { | |||||
462 | ### ignore blank or comment ... | ||||||||
463 | # comment lines with "#" eg. b002182.txt | ||||||||
464 | 0 | 0 | next; | ||||||
465 | } | ||||||||
466 | |||||||||
467 | # leading whitespace allowed as per b195467.txt | ||||||||
468 | 0 | 0 | 0 | if (my ($i, $value) = ($line =~ /^\s* | |||||
469 | ([0-9]+) # i | ||||||||
470 | [ \t]+ | ||||||||
471 | (-?[0-9]+) # value | ||||||||
472 | [ \t]* | ||||||||
473 | $/x)) { | ||||||||
474 | ### _readline: "$i $value" | ||||||||
475 | 0 | 0 | 0 | if (length($value) > _MAX_DIGIT_LENGTH) { | |||||
476 | 0 | 0 | $value = _to_bigint($value); | ||||||
477 | } | ||||||||
478 | 0 | 0 | $self->{'fh_i'} = $i+1; | ||||||
479 | 0 | 0 | return ($i, $value); | ||||||
480 | } | ||||||||
481 | } | ||||||||
482 | 0 | 0 | undef $self->{'fh_i'}; | ||||||
483 | 0 | 0 | return; | ||||||
484 | } | ||||||||
485 | |||||||||
486 | # Return true if the a000000.txt file in $self->{'fh'} looks good. | ||||||||
487 | # Various a-files are source code or tables rather than sequence values. | ||||||||
488 | # | ||||||||
489 | sub _afile_is_good { | ||||||||
490 | 0 | 0 | 0 | my ($self) = @_; | |||||
491 | 0 | 0 | my $fh = $self->{'fh'}; | ||||||
492 | 0 | 0 | my $good = 0; | ||||||
493 | 0 | 0 | my $prev_i; | ||||||
494 | 0 | 0 | while (defined (my $line = <$fh>)) { | ||||||
495 | 0 | 0 | chomp $line; | ||||||
496 | 0 | 0 | $line =~ tr/\r//d; # delete CR if CRLF line endings, eg. b009000.txt | ||||||
497 | ### $line | ||||||||
498 | |||||||||
499 | 0 | 0 | 0 | if ($line =~ /^\s*(#|$)/) { | |||||
500 | ### ignore blank or comment ... | ||||||||
501 | 0 | 0 | next; | ||||||
502 | } | ||||||||
503 | |||||||||
504 | # Must have line like "0 123". Can have negative OFFSET and so index i, | ||||||||
505 | # eg. A166242 (though that one doesn't have an A-file). | ||||||||
506 | 0 | 0 | 0 | my ($i,$value) = ($line =~ /^(-?[0-9]+) # i | |||||
507 | [ \t]+ | ||||||||
508 | (-?[0-9]+) # value | ||||||||
509 | [ \t]* | ||||||||
510 | $/x) | ||||||||
511 | or last; | ||||||||
512 | |||||||||
513 | 0 | 0 | 0 | 0 | if (defined $prev_i && $i != $prev_i+1) { | ||||
514 | ### bad A-file, initial "i" values not consecutive ... | ||||||||
515 | 0 | 0 | last; | ||||||
516 | } | ||||||||
517 | 0 | 0 | $prev_i = $i; | ||||||
518 | |||||||||
519 | 0 | 0 | $good++; | ||||||
520 | 0 | 0 | 0 | if ($good >= 3) { | |||||
521 | ### three good lines, A-file is good ... | ||||||||
522 | 0 | 0 | _seek ($self, 0); | ||||||
523 | 0 | 0 | return 1; | ||||||
524 | } | ||||||||
525 | } | ||||||||
526 | 0 | 0 | return 0; | ||||||
527 | } | ||||||||
528 | |||||||||
529 | sub _read_internal_txt { | ||||||||
530 | 65 | 65 | 62 | my ($self, $anum) = @_; | |||||
531 | ### _read_internal_txt(): $anum | ||||||||
532 | |||||||||
533 | 65 | 100 | 132 | return 0 if $self->{'_dont_use_internal'}; | |||||
534 | |||||||||
535 | 52 | 98 | foreach my $basefile ("$anum.internal.txt") { | ||||||
536 | 52 | 50 | 84 | my ($fullname, $contents) = _slurp_oeis_file($self,$basefile) | |||||
537 | or next; | ||||||||
538 | 0 | 0 | 0 | if (_HAVE_ENCODE) { | |||||
539 | # "Internal" text format is utf-8. | ||||||||
540 | 0 | 0 | $contents = Encode::decode('utf-8', $contents, Encode::FB_PERLQQ()); | ||||||
541 | } | ||||||||
542 | |||||||||
543 | ### $contents | ||||||||
544 | |||||||||
545 | # eg. "%O A007318 0,5" | ||||||||
546 | 0 | 0 | my $offset; | ||||||
547 | 0 | 0 | 0 | if ($contents =~ /^%O\s+\Q$anum\E\s+(\d+)/im) { | |||||
548 | 0 | 0 | $offset = $1; | ||||||
549 | ### %O line: $offset | ||||||||
550 | } else { | ||||||||
551 | 0 | 0 | $offset = 0; | ||||||
552 | } | ||||||||
553 | |||||||||
554 | # eg. "%N A007318 Pascal's triangle ..." | ||||||||
555 | 0 | 0 | 0 | if ($contents =~ m{^%N\s+\Q$anum\E\s+(.*)}im) { | |||||
556 | 0 | 0 | _set_description ($self, $1); | ||||||
557 | } else { | ||||||||
558 | ### description not matched ... | ||||||||
559 | } | ||||||||
560 | |||||||||
561 | # eg. "%K A007318 nonn,tabl,nice,easy,core,look,hear,changed" | ||||||||
562 | 0 | 0 | 0 | _set_characteristics ($self, | |||||
563 | $contents =~ /^%K\s+\Q$anum\E\s+(.*)/im && $1); | ||||||||
564 | |||||||||
565 | # the eishelp1.html says | ||||||||
566 | # %V,%W,%X lines for signed sequences | ||||||||
567 | # %S,%T,%U lines for non-negative sequences | ||||||||
568 | # though now %S is signed and unsigned both is it? | ||||||||
569 | # | ||||||||
570 | 0 | 0 | 0 | if (! $self->{'fh'}) { | |||||
571 | 0 | 0 | my @samples; | ||||||
572 | # capital %STU etc, but any case | ||||||||
573 | 0 | 0 | while ($contents =~ m{^%[VWX]\s+\Q$anum\E\s+(.*)}mg) { | ||||||
574 | 0 | 0 | push @samples, $1; | ||||||
575 | } | ||||||||
576 | 0 | 0 | 0 | unless (@samples) { | |||||
577 | 0 | 0 | while ($contents =~ m{^%[STU]\s+\Q$anum\E\s+(.*)}mg) { | ||||||
578 | 0 | 0 | push @samples, $1; | ||||||
579 | } | ||||||||
580 | 0 | 0 | 0 | unless (@samples) { | |||||
581 | 0 | 0 | croak "Oops list of values not found in ",$self->{'filename'}; | ||||||
582 | } | ||||||||
583 | } | ||||||||
584 | # join multiple lines of samples | ||||||||
585 | 0 | 0 | _split_sample_values ($self, join(', ',@samples)); | ||||||
586 | } | ||||||||
587 | |||||||||
588 | # %O "OFFSET" is subscript of first number. | ||||||||
589 | # Or for digit expansions it's the number of terms before the decimal | ||||||||
590 | # point, per http://oeis.org/eishelp2.html#RO | ||||||||
591 | # | ||||||||
592 | 0 | 0 | 0 | unless ($self->{'characteristic'}->{'digits'}) { | |||||
593 | 0 | 0 | $self->{'i'} = $self->{'i_start'} = $offset; | ||||||
594 | } | ||||||||
595 | ### i: $self->{'i'} | ||||||||
596 | ### i_start: $self->{'i_start'} | ||||||||
597 | |||||||||
598 | 0 | 0 | return 1; # success | ||||||
599 | } | ||||||||
600 | |||||||||
601 | 52 | 160 | return 0; # file not found | ||||||
602 | } | ||||||||
603 | |||||||||
604 | sub _read_internal_html { | ||||||||
605 | 65 | 65 | 53 | my ($self, $anum) = @_; | |||||
606 | ### _read_internal_html(): $anum | ||||||||
607 | |||||||||
608 | 65 | 100 | 128 | return 0 if $self->{'_dont_use_internal'}; | |||||
609 | |||||||||
610 | 52 | 90 | foreach my $basefile ("$anum.internal.html") { | ||||||
611 | 52 | 50 | 64 | my ($fullname, $contents) = _slurp_oeis_file($self,$basefile) | |||||
612 | or next; | ||||||||
613 | # "Internal" files are served as html with a charset indicator | ||||||||
614 | 0 | 0 | $contents = _decode_html_charset($contents); | ||||||
615 | ### $contents | ||||||||
616 | |||||||||
617 | 0 | 0 | my $offset; | ||||||
618 | 0 | 0 | 0 | if ($contents =~ /(^|)%O\s+(\d+)/im) { | |||||
619 | 0 | 0 | $offset = $2; | ||||||
620 | ### %O line: $offset | ||||||||
621 | } else { | ||||||||
622 | 0 | 0 | $offset = 0; | ||||||
623 | } | ||||||||
624 | |||||||||
625 | 0 | 0 | 0 | if ($contents =~ m{(^|)%N (.*?)(|$)}im) { | |||||
626 | 0 | 0 | _set_description ($self, $2); | ||||||
627 | } else { | ||||||||
628 | ### description not matched ... | ||||||||
629 | } | ||||||||
630 | |||||||||
631 | 0 | 0 | 0 | _set_characteristics ($self, | |||||
632 | $contents =~ /(^|)%K (.*?)(|$)/im | ||||||||
633 | && $2); | ||||||||
634 | |||||||||
635 | # the eishelp1.html says | ||||||||
636 | # %V,%W,%X lines for signed sequences | ||||||||
637 | # %S,%T,%U lines for non-negative sequences | ||||||||
638 | # though now %S is signed and unsigned both is it? | ||||||||
639 | # | ||||||||
640 | 0 | 0 | 0 | if (! $self->{'fh'}) { | |||||
641 | 0 | 0 | my @samples; | ||||||
642 | # capital %STU etc, but any case | ||||||||
643 | 0 | 0 | while ($contents =~ m{(^|<[tT][tT]>)%[VWX] (.*?)([tT][tT]>|$)}mg) { | ||||||
644 | 0 | 0 | push @samples, $2; | ||||||
645 | } | ||||||||
646 | 0 | 0 | 0 | unless (@samples) { | |||||
647 | 0 | 0 | while ($contents =~ m{(^|<[tT][tT]>)%[STU] (.*?)([tT][tT]>|$)}mg) { | ||||||
648 | 0 | 0 | push @samples, $2; | ||||||
649 | } | ||||||||
650 | 0 | 0 | 0 | unless (@samples) { | |||||
651 | 0 | 0 | croak "Oops list of values not found in ",$self->{'filename'}; | ||||||
652 | } | ||||||||
653 | } | ||||||||
654 | # join multiple lines of samples | ||||||||
655 | 0 | 0 | _split_sample_values ($self, join(', ',@samples)); | ||||||
656 | } | ||||||||
657 | |||||||||
658 | # %O "OFFSET" is subscript of first number. | ||||||||
659 | # Or for digit expansions it's the number of terms before the decimal | ||||||||
660 | # point, per http://oeis.org/eishelp2.html#RO | ||||||||
661 | # | ||||||||
662 | 0 | 0 | 0 | unless ($self->{'characteristic'}->{'digits'}) { | |||||
663 | 0 | 0 | $self->{'i'} = $self->{'i_start'} = $offset; | ||||||
664 | } | ||||||||
665 | ### i: $self->{'i'} | ||||||||
666 | ### i_start: $self->{'i_start'} | ||||||||
667 | |||||||||
668 | 0 | 0 | return 1; # success | ||||||
669 | } | ||||||||
670 | |||||||||
671 | 52 | 182 | return 0; # file not found | ||||||
672 | } | ||||||||
673 | |||||||||
674 | # Fill $self with contents of ~/OEIS/A000000.html but various fragile greps | ||||||||
675 | # of the html. | ||||||||
676 | # Return 1 if .html or .htm file exists, 0 if not. | ||||||||
677 | # | ||||||||
678 | sub _read_html { | ||||||||
679 | 65 | 65 | 56 | my ($self, $anum) = @_; | |||||
680 | ### _read_html(): $anum | ||||||||
681 | |||||||||
682 | 65 | 100 | 121 | return 0 if $self->{'_dont_use_html'}; | |||||
683 | |||||||||
684 | 52 | 77 | foreach my $basefile ("$anum.html", "$anum.htm") { | ||||||
685 | 104 | 50 | 127 | my ($fullname, $contents) = _slurp_oeis_file($self,$basefile) | |||||
686 | or next; | ||||||||
687 | 0 | 0 | $contents = _decode_html_charset($contents); | ||||||
688 | |||||||||
689 | 0 | 0 | 0 | if ($contents =~ | |||||
690 | m{$anum[ \t]*\n.*? # target anum | ||||||||
691 | ]*>\s*(?: | )? #empty | |||||||
692 | ]*> # | ||||||||
693 | \s* | ||||||||
694 | (.*?) # text through to ... | ||||||||
695 | ( |?td) # or | or ||||||||
696 | }isx) { | ||||||||
697 | 0 | 0 | _set_description ($self, $1); | ||||||
698 | } else { | ||||||||
699 | ### description not matched ... | ||||||||
700 | } | ||||||||
701 | |||||||||
702 | 0 | 0 | 0 | my $offset = ($contents =~ /OFFSET.*?<[tT][tT]>(\d+)/s | |||||
703 | && $1); | ||||||||
704 | ### $offset | ||||||||
705 | |||||||||
706 | # fragile grep out of the html ... | ||||||||
707 | 0 | 0 | my $keywords; | ||||||
708 | 0 | 0 | 0 | if ($contents =~ m{KEYWORD.*?<[tT][tT][^>]*>(.*?)[tT][tT]>}s) { | |||||
709 | ### html keywords match: $1 | ||||||||
710 | 0 | 0 | $keywords = $1; | ||||||
711 | } else { | ||||||||
712 | # die "Oops, KEYWORD not matched: $anum"; | ||||||||
713 | } | ||||||||
714 | 0 | 0 | _set_characteristics ($self, $keywords); | ||||||
715 | |||||||||
716 | 0 | 0 | 0 | if (! $self->{'fh'}) { | |||||
717 | # fragile grep out of the html ... | ||||||||
718 | 0 | 0 | $contents =~ s{>graph.*}{}; | ||||||
719 | 0 | 0 | $contents =~ m{.*([^<]+)}i; | ||||||
720 | 0 | 0 | my $list = $1; | ||||||
721 | 0 | 0 | _split_sample_values ($self, $list); | ||||||
722 | } | ||||||||
723 | |||||||||
724 | # %O "OFFSET" is subscript of first number, but for digit expansions | ||||||||
725 | # it's the position of the decimal point | ||||||||
726 | # http://oeis.org/eishelp2.html#RO | ||||||||
727 | 0 | 0 | 0 | if (! $self->{'characteristic'}->{'digits'}) { | |||||
728 | 0 | 0 | $self->{'i'} = $self->{'i_start'} = $offset; | ||||||
729 | } | ||||||||
730 | ### i: $self->{'i'} | ||||||||
731 | ### i_start: $self->{'i_start'} | ||||||||
732 | |||||||||
733 | 0 | 0 | return 1; | ||||||
734 | } | ||||||||
735 | 52 | 122 | return 0; | ||||||
736 | } | ||||||||
737 | |||||||||
738 | # Return the contents of ~/OEIS/$filename. | ||||||||
739 | # $filename is like "A000000.html" to be taken relative to oeis_dir(). | ||||||||
740 | # If $filename cannot be read then return undef. | ||||||||
741 | sub _slurp_oeis_file { | ||||||||
742 | 208 | 208 | 189 | my ($self,$filename) = @_; | |||||
743 | 208 | 210 | $filename = File::Spec->catfile (oeis_dir(), $filename); | ||||||
744 | ### $filename | ||||||||
745 | |||||||||
746 | 208 | 50 | 5824 | if (! open FH, "< $filename") { | |||||
747 | ### cannot open file: $! | ||||||||
748 | 208 | 590 | return; | ||||||
749 | } | ||||||||
750 | 0 | my $contents = do { local $/; |
|||||||
0 | |||||||||
0 | |||||||||
751 | 0 | 0 | close FH | ||||||
752 | or return; | ||||||||
753 | 0 | 0 | $self->{'filename'} ||= $filename; | ||||||
754 | 0 | return ($filename, $contents); | |||||||
755 | } | ||||||||
756 | |||||||||
757 | sub _set_description { | ||||||||
758 | 0 | 0 | my ($self, $description) = @_; | ||||||
759 | ### _set_description(): $description | ||||||||
760 | |||||||||
761 | 0 | $description =~ s/\s+$//; # trailing whitespace | |||||||
762 | 0 | $description =~ s/\s+/ /g; # collapse whitespace | |||||||
763 | 0 | $description =~ s/<[^>]*?>//sg; # tags |
|||||||
764 | 0 | $description =~ s/</ | |||||||
765 | 0 | $description =~ s/>/>/ig; # unentitize > | |||||||
766 | 0 | $description =~ s/&/&/ig; # unentitize & | |||||||
767 | 0 | $description =~ s/(\d+);/chr($1)/ge; # unentitize numeric ' and " | |||||||
0 | |||||||||
768 | |||||||||
769 | # ENHANCE-ME: maybe __x() if made available, or an sprintf "... %s" would | ||||||||
770 | # be enough ... | ||||||||
771 | 0 | $description .= "\n"; | |||||||
772 | 0 | 0 | if ($self->{'fh'}) { | ||||||
773 | $description .= sprintf(Math::NumSeq::__('Values from B-file %s'), | ||||||||
774 | 0 | $self->{'filename'}) | |||||||
775 | } else { | ||||||||
776 | $description .= sprintf(Math::NumSeq::__('Values from %s'), | ||||||||
777 | 0 | $self->{'filename'}) | |||||||
778 | } | ||||||||
779 | 0 | $self->{'description'} = $description; | |||||||
780 | } | ||||||||
781 | |||||||||
782 | sub _set_characteristics { | ||||||||
783 | 0 | 0 | my ($self, $keywords) = @_; | ||||||
784 | ### _set_characteristics() | ||||||||
785 | ### $keywords | ||||||||
786 | |||||||||
787 | 0 | 0 | if (! defined $keywords) { | ||||||
788 | 0 | return; # if perhaps match of .html failed | |||||||
789 | } | ||||||||
790 | |||||||||
791 | 0 | $keywords =~ s{<[^>]*>}{}g; # |
|||||||
792 | ### $keywords | ||||||||
793 | |||||||||
794 | 0 | 0 | foreach my $key (split /[, \t]+/, ($keywords||'')) { | ||||||
795 | ### $key | ||||||||
796 | 0 | $self->{'characteristic'}->{"OEIS_$key"} = 1; | |||||||
797 | } | ||||||||
798 | |||||||||
799 | # if ($self->{'characteristic'}->{'OEIS_cofr'}) { | ||||||||
800 | # $self->{'characteristic'}->{'continued_fraction'} = 1; | ||||||||
801 | # } | ||||||||
802 | |||||||||
803 | # "cons" means decimal digits of a constant | ||||||||
804 | # but don't reckon A000012 all-ones that way | ||||||||
805 | # "base" means non-decimal, it seems, maybe | ||||||||
806 | 0 | 0 | 0 | if ($self->{'characteristic'}->{'OEIS_cons'} | |||||
0 | |||||||||
807 | && ! $self->{'characteristic'}->{'OEIS_base'} | ||||||||
808 | && $self->{'anum'} ne 'A000012') { | ||||||||
809 | 0 | $self->{'values_min'} = 0; | |||||||
810 | 0 | $self->{'values_max'} = 9; | |||||||
811 | 0 | $self->{'characteristic'}->{'digits'} = 10; | |||||||
812 | } | ||||||||
813 | |||||||||
814 | 0 | 0 | if (defined (my $description = $self->{'description'})) { | ||||||
815 | 0 | 0 | if ($description =~ /expansion of .* in base (\d+)/i) { | ||||||
816 | 0 | $self->{'values_min'} = 0; | |||||||
817 | 0 | $self->{'values_max'} = $1 - 1; | |||||||
818 | 0 | $self->{'characteristic'}->{'digits'} = $1; | |||||||
819 | } | ||||||||
820 | 0 | 0 | if ($description =~ /^number of /i) { | ||||||
821 | 0 | $self->{'characteristic'}->{'count'} = 1; | |||||||
822 | } | ||||||||
823 | } | ||||||||
824 | } | ||||||||
825 | |||||||||
826 | sub _split_sample_values { | ||||||||
827 | 0 | 0 | my ($self, $str) = @_; | ||||||
828 | ### _split_sample_values(): $str | ||||||||
829 | 0 | 0 | 0 | unless (defined $str && $str =~ m{^([0-9,-]|\s)+$}) { | |||||
830 | 0 | 0 | croak "Oops list of sample values not recognised in ",$self->{'filename'},"\n", | ||||||
831 | (defined $str ? $str : ()); | ||||||||
832 | } | ||||||||
833 | 0 | $self->{'array'} = [ split /[, \t\r\n]+/, $str ]; | |||||||
834 | } | ||||||||
835 | |||||||||
836 | sub _decode_html_charset { | ||||||||
837 | 0 | 0 | my ($contents) = @_; | ||||||
838 | |||||||||
839 | # eg. | ||||||||
840 | # HTTP::Message has a blob of code for this, using the full HTTP::Parser, | ||||||||
841 | # but a slack regexp should be enough for OEIS pages. | ||||||||
842 | # | ||||||||
843 | 0 | 0 | 0 | if (_HAVE_ENCODE | |||||
844 | && $contents =~ m{]+ | ||||||||
845 | http-equiv=[^>]+ | ||||||||
846 | content-type[^>]+ | ||||||||
847 | charset=([a-z0-9-_]+)}isx) { | ||||||||
848 | 0 | return Encode::decode($1, $contents, Encode::FB_PERLQQ()); | |||||||
849 | } else { | ||||||||
850 | 0 | return $contents; | |||||||
851 | } | ||||||||
852 | } | ||||||||
853 | |||||||||
854 | #------------------------------------------------------------------------------ | ||||||||
855 | |||||||||
856 | # Similar bsearch to Search::Dict, but Search::Dict doesn't allow for | ||||||||
857 | # comment lines at the start of the file or blank lines at the end. | ||||||||
858 | # | ||||||||
859 | #use Smart::Comments; | ||||||||
860 | |||||||||
861 | sub ith { | ||||||||
862 | 0 | 0 | 1 | my ($self, $i) = @_; | |||||
863 | ### ith(): "$i cf fh_i=".($self->{'fh_i'} || -999) | ||||||||
864 | |||||||||
865 | 0 | 0 | if (my $fh = $self->{'fh'}) { | ||||||
866 | 0 | 0 | if (! defined $self->{'next_seek'}) { | ||||||
867 | 0 | $self->{'next_seek'} = tell($fh); | |||||||
868 | } | ||||||||
869 | |||||||||
870 | 0 | 0 | 0 | if (defined $self->{'fh_i'} && $i <= $self->{'fh_i'} + 20) { | |||||
871 | ### fh_i is target ... | ||||||||
872 | 0 | 0 | if (my ($line_i, $value) = _readline($self)) { | ||||||
873 | 0 | 0 | if ($line_i == $i) { | ||||||
874 | 0 | return $value; | |||||||
875 | } | ||||||||
876 | } | ||||||||
877 | } | ||||||||
878 | |||||||||
879 | 0 | my $lo = 0; | |||||||
880 | 0 | my $hi = -s $fh; | |||||||
881 | 0 | for (;;) { | |||||||
882 | ### at: "lo=$lo hi=$hi consider mid=".int(($lo+$hi)/2) | ||||||||
883 | 0 | my $mid = int(($lo+$hi)/2); | |||||||
884 | 0 | _seek ($self, $mid); | |||||||
885 | |||||||||
886 | 0 | 0 | if (! defined(readline $fh)) { | ||||||
887 | ### mid is EOF ... | ||||||||
888 | 0 | last; | |||||||
889 | } | ||||||||
890 | ### skip partial line to: tell($fh) | ||||||||
891 | 0 | $mid = tell($fh); | |||||||
892 | 0 | 0 | if ($mid >= $hi) { | ||||||
893 | 0 | last; | |||||||
894 | } | ||||||||
895 | |||||||||
896 | 0 | 0 | my ($line_i,$value) = _readline($self) | ||||||
897 | or last; # only blank lines between $mid and EOF, go linear | ||||||||
898 | |||||||||
899 | ### $line_i | ||||||||
900 | ### $value | ||||||||
901 | 0 | 0 | if ($line_i == $i) { | ||||||
902 | ### found by binary search ... | ||||||||
903 | 0 | return $value; | |||||||
904 | } | ||||||||
905 | 0 | 0 | if ($line_i < $i) { | ||||||
906 | ### line_i before the target, advance lo ... | ||||||||
907 | 0 | $lo = tell($fh); | |||||||
908 | } else { | ||||||||
909 | ### line_i after target, reduce hi ... | ||||||||
910 | 0 | $hi = $mid; | |||||||
911 | } | ||||||||
912 | } | ||||||||
913 | |||||||||
914 | 0 | _seek ($self, $lo); | |||||||
915 | 0 | for (;;) { | |||||||
916 | 0 | 0 | my ($line_i,$value) = _readline($self) | ||||||
917 | or last; | ||||||||
918 | 0 | 0 | if ($line_i == $i) { | ||||||
919 | ### found by linear search ... | ||||||||
920 | 0 | $self->{'fh_i'} = $line_i+1; | |||||||
921 | 0 | return $value; | |||||||
922 | } | ||||||||
923 | 0 | 0 | if ($line_i > $i) { | ||||||
924 | 0 | return undef; | |||||||
925 | } | ||||||||
926 | } | ||||||||
927 | 0 | return undef; | |||||||
928 | |||||||||
929 | } else { | ||||||||
930 | 0 | $i -= $self->i_start; | |||||||
931 | 0 | 0 | unless ($i >= 0) { | ||||||
932 | 0 | return undef; # negative or NaN | |||||||
933 | } | ||||||||
934 | 0 | return $self->{'array'}->[$i]; | |||||||
935 | } | ||||||||
936 | } | ||||||||
937 | |||||||||
938 | 1; | ||||||||
939 | __END__ |