File Coverage

blib/lib/Math/OEIS/Stripped.pm
Criterion Covered Total %
statement 55 57 96.4
branch 14 18 77.7
condition 6 11 54.5
subroutine 14 14 100.0
pod 5 7 71.4
total 94 107 87.8


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019 Kevin Ryde
2              
3             # This file is part of Math-OEIS.
4             #
5             # Math-OEIS is free software; you can redistribute it and/or modify it
6             # under the terms of the GNU General Public License as published by the Free
7             # Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Math-OEIS 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-OEIS. If not, see .
17              
18              
19             package Math::OEIS::Stripped;
20 3     3   75636 use 5.006;
  3         23  
21 3     3   16 use strict;
  3         4  
  3         60  
22 3     3   23 use warnings;
  3         6  
  3         114  
23 3     3   18 use Carp 'croak';
  3         6  
  3         142  
24              
25 3     3   506 use Math::OEIS::SortedFile;
  3         7  
  3         179  
26             our @ISA = ('Math::OEIS::SortedFile');
27              
28             # uncomment this to run the ### lines
29             # use Smart::Comments;
30              
31             our $VERSION = 14;
32              
33 3     3   18 use constant base_filename => 'stripped';
  3         6  
  3         280  
34              
35             # Maximum number of decimal digits which fit within a Perl UV integer.
36             # For example a 32-bit IV goes up to 2^31-1 = 2147483647 and in that case
37             # _IV_DECIMAL_DIGITS_MAX is 9 since values up to and including 9 digits
38             # fit into a UV. Some 10 digit values fit too, but not all 10 digits.
39             #
40 3     3   20 use constant _IV_DECIMAL_DIGITS_MAX => length((~0)>>1)-1;
  3         5  
  3         2001  
41              
42             sub new {
43 1     1 1 1778 my $class = shift;
44 1         11 return $class->SUPER::new (use_bigint => 'if_necessary',
45             @_);
46             }
47              
48             sub anum_to_values_str {
49 12     12 1 2238 my ($self, $anum) = @_;
50             ### Stripped anum_to_values_str(): $anum
51              
52 12         33 my $line = $self->anum_to_line($anum);
53 12 100       32 if (! defined $line) { return undef; }
  6         16  
54              
55 6 100       14 my ($got_anum, $values_str) = $self->line_split_anum($line)
56             or return undef; # draft sequence ,, treated same as no such A-number
57              
58 4         10 return $values_str;
59             }
60              
61             sub anum_to_values {
62 7     7 1 3740 my ($self, $anum) = @_;
63 7 50       21 if (! ref $self) { $self = $self->instance; }
  0         0  
64 7         10 my @values;
65 7         15 my $values_str = $self->anum_to_values_str($anum);
66 7 100       20 if (defined $values_str) {
67 3         9 @values = $self->values_split($values_str);
68             }
69 7         27 return @values;
70             }
71              
72             sub values_split {
73 3     3 1 8 my ($self, $values_str) = @_;
74 3 50       9 if (! ref $self) { $self = $self->instance; }
  0         0  
75              
76 3         13 my @values = split /,/, $values_str;
77 3 50       12 if (my $use_bigint = $self->{'use_bigint'}) {
78 3         6 foreach my $value (@values) {
79 9 100 66     43 if ($use_bigint eq '1'
      66        
80             || ($use_bigint eq 'if_necessary'
81             && length($value) > _IV_DECIMAL_DIGITS_MAX)) {
82 1         6 $value = $self->bigint_class_load->new($value); # mutate array
83             }
84             }
85             }
86 3         24504 return @values;
87             }
88              
89             # Not documented yet.
90             # Return a class name which is the BigInt class to use for values from the
91             # stripped file. This class has been loaded ready for use.
92             sub bigint_class_load {
93 1     1 0 2 my ($self) = @_;
94 1   33     5 return ($self->{'bigint_class_load'} ||= do {
95 1         629 require Module::Load;
96 1         1238 my $bigint_class = $self->bigint_class;
97 1         4 Module::Load::load($bigint_class);
98             ### $bigint_class
99 1         27592 $bigint_class
100             });
101             }
102              
103             # Not documented yet.
104             # Return a class name which is the BigInt class to use for values from the
105             # stripped file. This is the C specified in the object, or
106             # default C<'Math::BigInt'>.
107             #
108             # If you want a particular Math::BigInt back-end then have a usual
109             # use Math::BigInt try => 'GMP';
110             # or similar in your mainline code. No C is applied here since it is a
111             # global.
112             #
113             sub bigint_class {
114 1     1 0 4 my ($self) = @_;
115 1   50     8 return ($self->{'bigint_class'} || 'Math::BigInt');
116             }
117              
118             sub line_split_anum {
119 9     9 1 2908 my ($self, $line) = @_;
120             ### Stripped line_split_anum(): $line
121 9 100       91 $line =~ /^(A\d+)(\s+)(,+)([-0-9].*?)(\s|,)*$/
122             or return; # no match of comment line "# ..." or maybe a blank
123 5 50       20 if (length($3) > 1) {
124             # initial ,, is empty values for a draft sequence
125             }
126              
127             # use substr() to preserve taintedness of input $line
128 5         49 return (substr($line,0,length($1)),
129             substr($line,
130             length($1)+length($2)+length($3),
131             length($4)));
132             }
133              
134             1;
135             __END__