File Coverage

blib/lib/Math/NumSeq/OEIS/Catalogue/Plugin/ZZ_Files.pm
Criterion Covered Total %
statement 33 68 48.5
branch 4 22 18.1
condition 0 3 0.0
subroutine 9 15 60.0
pod 0 3 0.0
total 46 111 41.4


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             package Math::NumSeq::OEIS::Catalogue::Plugin::ZZ_Files;
19 2     2   1141 use 5.004;
  2         5  
20 2     2   6 use strict;
  2         2  
  2         30  
21 2     2   6 use File::Spec;
  2         2  
  2         28  
22 2     2   399 use Math::NumSeq::OEIS::File;
  2         2  
  2         41  
23              
24 2     2   5 use vars '@ISA';
  2         2  
  2         61  
25 2     2   7 use Math::NumSeq::OEIS::Catalogue::Plugin;
  2         1  
  2         48  
26             @ISA = ('Math::NumSeq::OEIS::Catalogue::Plugin');
27              
28 2     2   6 use Math::NumSeq::OEIS::Catalogue::Plugin::FractionDigits;
  2         2  
  2         53  
29             *_anum_to_num
30             = \&Math::NumSeq::OEIS::Catalogue::Plugin::FractionDigits::_anum_to_num;
31              
32 2     2   5 use vars '$VERSION';
  2         2  
  2         1023  
33             $VERSION = 72;
34              
35             # uncomment this to run the ### lines
36             #use Smart::Comments;
37              
38              
39             sub _make_info {
40 0     0   0 my ($anum) = @_;
41             ### _make_info(): $anum
42 0         0 return { anum => $anum,
43             class => 'Math::NumSeq::OEIS::File',
44             parameters => [ anum => $anum ] };
45             }
46              
47             sub anum_to_info {
48 0     0 0 0 my ($class, $anum) = @_;
49             ### Catalogue-ZZ_Files num_to_info(): @_
50              
51 0         0 my $dir = Math::NumSeq::OEIS::File::oeis_dir();
52 0 0       0 foreach my $anum ($anum,
53             # A0123456 shortened to A123456
54             ($anum =~ /A0(\d{6})/ ? "A$1" : ())) {
55 0         0 foreach my $basename
56             ("$anum.internal",
57             "$anum.internal.html",
58             "$anum.html",
59             "$anum.htm",
60             Math::NumSeq::OEIS::File::anum_to_bfile($anum),
61             Math::NumSeq::OEIS::File::anum_to_bfile($anum,'a')) {
62 0         0 my $filename = File::Spec->catfile ($dir, $basename);
63             ### $filename
64 0 0       0 if (-e $filename) {
65 0         0 return _make_info($anum);
66             }
67             }
68             }
69 0         0 return undef;
70             }
71              
72             # on getting up to perhaps 2000 files of 500 anums it becomes a bit slow
73             # re-reading the directory on every anum_next(), cache a bit for speed
74              
75             my $cached_arrayref = [];
76             my $cached_mtime = -1;
77             my $cached_time = -1;
78              
79             sub info_arrayref {
80 130     130 0 104 my ($class) = @_;
81              
82             # stat() at most once per second
83 130         124 my $time = time();
84 130 100       185 if ($cached_time != $time) {
85 1         1 $cached_time = $time;
86              
87             # if $dir mtime changed then re-read
88 1         3 my $dir = Math::NumSeq::OEIS::File::oeis_dir();
89 1         58 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
90             $atime,$mtime,$ctime,$blksize,$blocks) = stat($dir);
91 1 50       3 if (! defined $mtime) { $mtime = -1; } # if $dir doesn't exist
  1         1  
92 1 50       3 if ($cached_mtime != $mtime) {
93 0         0 $cached_mtime = $mtime;
94 0         0 $cached_arrayref = nocache_info_arrayref($dir);
95             }
96             }
97 130         311 return $cached_arrayref;
98             }
99              
100             sub nocache_info_arrayref {
101 0     0 0   my ($dir) = @_;
102             ### nocache_info_arrayref(): $dir
103              
104 0           my @ret;
105             _anum_traverse(sub {
106 0     0     my ($num) = @_;
107 0           my $anum = _num_to_anum($num);
108 0           push @ret, _make_info($anum);
109 0           return 1; # continue
110 0           });
111 0           return \@ret;
112             }
113             sub _anum_traverse {
114 0     0     my ($callback) = @_;
115              
116 0           my $dir = Math::NumSeq::OEIS::File::oeis_dir();
117 0 0         if (! opendir DIR, $dir) {
118             ### cannot opendir: $!
119 0           return;
120             }
121 0           my %seen;
122 0           while (defined (my $basename = readdir DIR)) {
123             ### $basename
124              
125             # stat() on every file is a bit slow ...
126             # unless (-e File::Spec->catfile($dir,$basename)) {
127             # ### skip dangling symlink ...
128             # next;
129             # }
130              
131             # Case insensitive for MS-DOS. But dunno what .internal or
132             # .internal.html will be or should be on an 8.3 DOS filesystem. Maybe
133             # "A000000.int", maybe "A000000i.htm" until 7-digit A-numbers.
134 0 0         next unless $basename =~ m{^(
135             A(\d*)(\.internal)?(\.html?)? # $2 num
136             |[ab](\d*)\.txt # $5 num
137             )$}ix;
138 0   0       my $num = ($2||$5)+0; # numize
139 0 0         next if $seen{$num}++; # uniquify
140 0 0         last unless &$callback($num);
141             }
142 0 0         closedir DIR or die "Error closing $dir: $!";
143             }
144              
145             # Works, but cached array might be enough.
146             #
147             # sub anum_after {
148             # my ($class, $after_anum) = @_;
149             # my $after_num = _anum_to_num($after_anum);
150             # ### $after_num
151             # my $ret_num;
152             # _anum_traverse(sub {
153             # my ($num) = @_;
154             # ### $num
155             # if ($num > $after_num
156             # && (! defined $ret_num || $num < $ret_num)) {
157             # $ret_num = $num;
158             # ### new ret: $ret_num
159             # if ($ret_num == $after_num + 1) {
160             # return 0; # stop, found after+1
161             # }
162             # }
163             # return 1; # continue
164             # });
165             # return _num_to_anum($ret_num);
166             # }
167             # sub anum_before {
168             # my ($class, $before_anum) = @_;
169             # my $before_num = _anum_to_num($before_anum);
170             # my $ret_num;
171             # _anum_traverse(sub {
172             # my ($num) = @_;
173             # if ($num > $before_num
174             # && (! defined $ret_num || $num < $ret_num)) {
175             # $ret_num = $num;
176             # if ($ret_num == $before_num - 1) {
177             # return 0; # stop, found before-1
178             # }
179             # }
180             # return 1; # continue
181             # });
182             # return _num_to_anum($ret_num);
183             # }
184              
185             #------------------------------------------------------------------------------
186              
187             sub _num_to_anum {
188 0     0     my ($num) = @_;
189 0 0         if (defined $num) {
190 0           return sprintf 'A%06d', $num;
191             } else {
192 0           return undef;
193             }
194             }
195              
196             1;
197             __END__