File Coverage

blib/lib/Math/DifferenceSet/Planar/Data.pm
Criterion Covered Total %
statement 130 130 100.0
branch 43 50 86.0
condition 12 15 80.0
subroutine 41 41 100.0
pod 20 20 100.0
total 246 256 96.0


line stmt bran cond sub pod time code
1             package Math::DifferenceSet::Planar::Data;
2              
3 7     7   86821 use strict;
  7         26  
  7         300  
4 7     7   39 use warnings;
  7         29  
  7         388  
5 7     7   39 use Carp qw(croak);
  7         14  
  7         483  
6 7     7   41 use File::Spec;
  7         15  
  7         330  
7 7     7   3712 use File::Share qw(dist_dir);
  7         286803  
  7         624  
8 7     7   6006 use DBD::SQLite::Constants qw(SQLITE_OPEN_READONLY);
  7         317997  
  7         1566  
9 7     7   4328 use Math::DifferenceSet::Planar::Schema;
  7         92  
  7         369  
10              
11             # Math::DifferenceSet::Planar::Data=ARRAY(...)
12              
13             # .......... index .......... # .......... value ..........
14 7     7   92 use constant _F_DATA => 0; # difference set result set object
  7         16  
  7         676  
15 7     7   148 use constant _F_SPACES => 1; # PDS space result set object or undef
  7         17  
  7         433  
16 7     7   39 use constant _F_VERSION => 2; # PDS space result set object or undef
  7         12  
  7         341  
17 7     7   50 use constant _F_PATH => 3; # database path name
  7         19  
  7         341  
18 7     7   34 use constant _NFIELDS => 4;
  7         12  
  7         863  
19              
20             our $VERSION = '1.003';
21             our @CARP_NOT = qw(Math::DifferenceSet::Planar);
22              
23             our $DATABASE_DIR = dist_dir('Math-DifferenceSet-Planar');
24              
25 7     7   71 use constant _KNOWN => { '<>' => 0 };
  7         14  
  7         15325  
26              
27             # ----- private subroutines -----
28              
29             sub _iterate {
30 24     24   79 my ($domain, $query, $min, $max, @columns) = @_;
31 24 100       87 my @sel = $query? @{$query}: ();
  6         19  
32 24         129 my @osel = ();
33 24         55 my $dir = 'ASC';
34 24 100 100     197 if (defined($min) && defined($max) && $min > $max) {
      100        
35 4         17 ($min, $max, $dir) = ($max, $min, 'DESC');
36             }
37 24 100       94 push @osel, '>=' => $min if defined $min;
38 24 100       108 push @osel, '<=' => $max if defined $max;
39 24 100       143 push @sel, order_ => { @osel } if @osel;
40 24 100       241 my $results = $domain->search(
    100          
41             @sel? { @sel }: undef,
42             {
43             @columns? ( columns => \@columns ): (),
44             order_by => "order_ $dir",
45             }
46             );
47 24     104   9818 return sub { $results->next };
  104         42125  
48             }
49              
50             # ----- private accessor methods -----
51              
52 144     144   1142 sub _data { $_[0]->[_F_DATA] }
53 33     33   93 sub _spaces { $_[0]->[_F_SPACES] }
54 2     2   7 sub _version { $_[0]->[_F_VERSION] }
55 1     1   6 sub _path { $_[0]->[_F_PATH] }
56              
57             sub _get_version_of {
58 2     2   9 my ($this, $table_name) = @_;
59 2         7 my $version = $this->_version;
60 2 50       13 return (0, 0) if !defined $version;
61 2         15 my $rec = $version->search({ table_name => $table_name })->single;
62 2 50       5896 return (0, 0) if !defined $rec;
63 2         148 return ($rec->major, $rec->minor);
64             }
65              
66             # ----- class methods -----
67              
68             sub list_databases {
69 8 50   8 1 828 opendir my $dh, $DATABASE_DIR or return ();
70             my @files =
71             map {
72 12 100       74 my $is_standard = /^pds[_\W]/i? 1: 0;
73 12         473 my $path = File::Spec->rel2abs($_, $DATABASE_DIR);
74 12 50       330 (-f $path)? [$_, $is_standard, -s _]: ()
75             }
76 8         417 grep { /\.db\z/i } readdir $dh;
  40         154  
77 8         198 closedir $dh;
78             return
79 12         92 map { $_->[0] }
80             sort {
81 8 50 66     63 $b->[1] <=> $a->[1] || $b->[2] <=> $a->[2] ||
  6         38  
82             $a->[0] cmp $b->[0]
83             }
84             @files;
85             }
86              
87             sub new {
88 14     14 1 277100 my $class = shift;
89 14 100       95 my ($filename) = @_? @_: $class->list_databases
    50          
90             or croak "bad database: empty share directory: $DATABASE_DIR";
91 14         307 my $path = File::Spec->rel2abs($filename, $DATABASE_DIR);
92 14 100       863 -e $path or croak "bad database: file does not exist: $path";
93 12         313 my $schema =
94             Math::DifferenceSet::Planar::Schema->connect(
95             "dbi:SQLite:$path", q[], q[],
96             { sqlite_open_flags => SQLITE_OPEN_READONLY },
97             );
98 12         663802 my $data = $schema->resultset('DifferenceSet');
99 12         7704 my $count = eval { $data->search->count };
  12         57  
100 12 100       423856 croak "bad database: query failed: $@" if !defined $count;
101 11         337 my $spaces = $schema->resultset('DifferenceSetSpace');
102 11 100       5098 undef $spaces if !eval { $spaces->search->count };
  11         52  
103 11         54219 my $version = $schema->resultset('DatabaseVersion');
104 11 50       4727 undef $version if !eval { $version->search->count };
  11         58  
105 11         44356 return bless [$data, $spaces, $version, $path], $class;
106             }
107              
108             # ----- object methods -----
109              
110             sub get {
111 74     74 1 5222 my ($this, $order, @columns) = @_;
112 74 100       300 return $this->_data->search(
113             { order_ => $order },
114             @columns ? { columns => \@columns } : ()
115             )->single;
116             }
117              
118             sub get_space {
119 12     12 1 1516 my ($this, $order) = @_;
120 12         53 my $spaces = $this->_spaces;
121 12 100       53 return undef if !defined $spaces;
122 11         77 return $spaces->search({ order_ => $order })->single;
123             }
124              
125 1     1 1 4573 sub get_version { $_[0]->_get_version_of('difference_set') }
126 1     1 1 1436 sub get_space_version { $_[0]->_get_version_of('difference_set_space') }
127              
128             sub iterate {
129 6     6 1 20 my ($this, $min, $max) = @_;
130 6         22 return _iterate($this->_data, undef, $min, $max);
131             }
132              
133             sub iterate_properties {
134 7     7 1 11210 my ($this, $min, $max, @columns) = @_;
135 7         23 foreach my $col (@columns) {
136 3 100       15 $col = 'order_' if $col eq 'order';
137             }
138             @columns =
139 7 100       273 grep {!/delta/}
  30         1228  
140             Math::DifferenceSet::Planar::Schema::Result::DifferenceSet->columns
141             if !@columns;
142 7         52 return _iterate($this->_data, undef, $min, $max, @columns);
143             }
144              
145             sub iterate_refs {
146 6     6 1 18 my ($this, $type, $min, $max) = @_;
147 6         21 return _iterate($this->_data, [$type => { '<>' => 0 }], $min, $max);
148             }
149              
150             sub iterate_spaces {
151 6     6 1 3763 my ($this, $min, $max) = @_;
152 6         23 my $spaces = $this->_spaces;
153 6 100   1   28 return sub {} if !defined $spaces;
154 5         22 return _iterate($spaces, undef, $min, $max);
155             }
156              
157 4     4 1 3504 sub min_order { $_[0]->_data->get_column('order_')->min }
158 22     22 1 13003 sub max_order { $_[0]->_data->get_column('order_')->max }
159 7     7 1 11706 sub count { $_[0]->_data->search->count }
160 1     1 1 7012 sub path { $_[0]->_path }
161              
162             sub sp_min_order {
163 3     3 1 5793 my ($this) = @_;
164 3         15 my $spaces = $this->_spaces;
165 3   66     37 return $spaces && $spaces->get_column('order_')->min;
166             }
167              
168             sub sp_max_order {
169 9     9 1 4963 my ($this) = @_;
170 9         34 my $spaces = $this->_spaces;
171 9   66     109 return $spaces && $spaces->get_column('order_')->max;
172             }
173              
174             sub sp_count {
175 3     3 1 6571 my ($this) = @_;
176 3         14 my $spaces = $this->_spaces;
177 3 100       19 return 0 if !defined $spaces;
178 2         14 return $spaces->search->count;
179             }
180              
181             sub ref_min_order {
182 6     6 1 41 my ($this, $type) = @_;
183 6         25 return $this->_data->search({$type => _KNOWN})->get_column('order_')->min;
184             }
185              
186             sub ref_max_order {
187 6     6 1 44 my ($this, $type) = @_;
188 6         25 return $this->_data->search({$type => _KNOWN})->get_column('order_')->max;
189             }
190              
191             sub ref_count {
192 6     6 1 23 my ($this, $type) = @_;
193 6         27 return $this->_data->search({$type => _KNOWN})->count;
194             }
195              
196             1;
197              
198             __END__