File Coverage

blib/lib/DiaColloDB/EnumFile/FixedMap.pm
Criterion Covered Total %
statement 15 89 16.8
branch 0 30 0.0
condition 0 20 0.0
subroutine 5 14 35.7
pod 7 9 77.7
total 27 162 16.6


line stmt bran cond sub pod time code
1             ### -*- Mode: CPerl -*-
2             ## File: DiaColloDB::EnumFile::FixedMap.pm
3             ## Author: Bryan Jurish <moocow@cpan.org>
4             ## Description: collocation db, symbol<->integer enum, fixed-length symbols, mmaped
5              
6             package DiaColloDB::EnumFile::FixedMap;
7 1     1   8 use DiaColloDB::EnumFile::FixedLen;
  1         3  
  1         36  
8 1     1   7 use DiaColloDB::Utils qw(:fcntl :file :json :regex :pack);
  1         2  
  1         37  
9 1     1   918 use File::Map qw(map_handle);
  1         7091  
  1         5  
10 1     1   162 use Fcntl qw(:DEFAULT :seek);
  1         2  
  1         33  
11 1     1   529 use strict;
  1         2  
  1         1118  
12              
13             ##==============================================================================
14             ## Globals & Constants
15              
16             our @ISA = qw(DiaColloDB::EnumFile::FixedLen);
17              
18             ##==============================================================================
19             ## Constructors etc.
20              
21             ## $cldb = CLASS_OR_OBJECT->new(%args)
22             ## + %args, object structure:
23             ## (
24             ## ##-- EnumFile: basic options
25             ## base => $base, ##-- database basename; use files "${base}.fsx", "${base}.fix", "${base}.hdr"
26             ## perms => $perms, ##-- default: 0666 & ~umask
27             ## flags => $flags, ##-- default: 'r'
28             ## pack_i => $pack_i, ##-- integer pack template (default='N')
29             ## #pack_o => $pack_o, ##-- file offset pack template (default='N') ; OVERRIDE/FixedLen: unused
30             ## #pack_l => $pack_l, ##-- string-length pack template (default='n'); OVERRIDE/FixedLen: unused
31             ## pack_s => $pack_s, ##-- string pack template for text i/o; OVERRIDE:REQUIRED (default='Nn')
32             ## size => $size, ##-- number of mapped symbols, like scalar(@i2s)
33             ## ##
34             ## ##-- EnumFile: in-memory construction
35             ## s2i => \%s2i, ##-- maps symbols to integers
36             ## i2s => \@i2s, ##-- maps integers to symbols
37             ## dirty => $bool, ##-- true if in-memory structures are not in-sync with file data
38             ## loaded => $bool, ##-- true if file data has been loaded to memory
39             ## ##
40             ## ##-- EnumFile: pack lengths (after open())
41             ## len_i => $len_i, ##-- packsize($pack_i)
42             ## #len_o => $len_o, ##-- packsize($pack_o) ; OVERRIDE/FixedLen: unused
43             ## #len_l => $len_l, ##-- packsize($pack_l) ; OVERRIDE/FixedLen: unused
44             ## len_s => $len_s, ##-- packsize($pack_s); OVERRIDE/FixedLen: new
45             ## len_sx => $len_sx, ##-- $len_s + $len_i ; OVERRIDE/FixedLen: new value
46             ## ##
47             ## ##-- EnumFile: filehandles (after open())
48             ## #sfh => $sfh, ##-- $base.s : OVERRIDE/FixedLen: unused
49             ## ixfh => $ixfh, ##-- $base.fix : [$i] => pack("${pack_s}", $s_with_id_i) : OVERRIDE/FixedLen: new extension, format
50             ## sxfh => $sxfh, ##-- $base.fsx : [$j] => pack("${pack_s}${pack_i}", $s_with_sortorder_j_and_id_i, $i) : OVERRIDE/FixedLen: new extension, format
51             ## ##
52             ## ##-- FixedMap: buffers
53             ## #sbufr => \$sbuf, ##-- mmap $base.s # OVERRIDE/FixedMap: unused
54             ## ixbufr => \$ixbuf, ##-- mmap $base.fix # OVERRIDE/FixedMap: new format
55             ## sxbufr => \$sxbuf, ##-- mmap $base.fsx # OVERRIDE/FixedMap: new format
56             ## )
57             sub new {
58 0     0 1   my $that = shift;
59 0           return $that->SUPER::new(
60             @_, ##-- user arguments
61             );
62             }
63              
64             ##==============================================================================
65             ## I/O
66              
67             ##--------------------------------------------------------------
68             ## I/O: open/close (file)
69              
70             ## $enum_or_undef = $enum->open($base,$flags)
71             ## $enum_or_undef = $enum->open($base)
72             ## $enum_or_undef = $enum->open()
73             sub open {
74 0     0 1   my ($enum,$base,$flags) = @_;
75 0 0         $enum->SUPER::open($base,$flags) or return undef;
76 0           return $enum->remap();
77             }
78              
79             ## $enum_or_undef = $enum->remap()
80             ## + re-maps mmap buffers from enum handles
81             sub remap {
82 0     0 0   my $enum = shift;
83              
84             ##-- mmap handles
85 0           my $mapmode = fcperl($enum->{flags});
86 0           map_handle(my $ixbuf, $enum->{ixfh}, $mapmode);
87 0           map_handle(my $sxbuf, $enum->{sxfh}, $mapmode);
88              
89             ##-- buffers
90 0           $enum->{ixbufr} = \$ixbuf;
91 0           $enum->{sxbufr} = \$sxbuf;
92              
93             ##-- flags
94 0           $enum->{loaded} = 0;
95              
96 0           return $enum;
97             }
98              
99             ## $enum_or_undef = $enum->close()
100             ## + INHERITED
101              
102             ## $bool = $enum->opened()
103             sub opened {
104 0     0 1   my $enum = shift;
105             return
106             (
107             #defined($enum->{base}) &&
108             #defined($enum->{sbufr}) &&
109             defined($enum->{ixbufr})
110             && defined($enum->{sxbufr})
111 0   0       );
112             }
113              
114             ## $bool = $enum->reopen()
115             ## + re-opens datafiles
116             ## + override also remaps buffers
117             sub reopen {
118 0     0 0   my $enum = shift;
119 0   0       return $enum->SUPER::reopen() && $enum->remap();
120             }
121              
122              
123             ## $bool = $enum->dirty()
124             ## + returns true iff some in-memory structures haven't been flushed to disk
125             ## + INHERITED
126              
127             ## $bool = $enum->flush()
128             ## + flush in-memory structures to disk
129             ## + clobbers any old disk-file contents with in-memory maps
130             ## + enum must be opened in write-mode
131             ## + invalidates any old references to {s2i}, {i2s} (but doesn't empty them if you need to keep a reference)
132             ## + INHERITED
133              
134             ##--------------------------------------------------------------
135             ## I/O: memory <-> file
136              
137             ## \@i2s = $enum->toArray()
138             sub toArray {
139 0     0 1   my $enum = shift;
140 0 0 0       return $enum->{i2s} if ($enum->loaded || !$enum->opened);
141              
142             ##-- bizarre bug Mon, 03 Aug 2015 15:46:27 +0200 on plato
143             ## + getting 9-byte items in this array for 10-byte (4+4+2) records
144             ## + i2s() works as expected
145             ## + wtf?!
146             #my @i2s = unpack("(A[$enum->{len_s}])*", ${$enum->{ixbufr}});
147 0           my $len_s = $enum->{len_s};
148 0           my @i2s = map {substr(${$enum->{ixbufr}},$_*$len_s,$len_s)} (0..($enum->size-1));
  0            
  0            
149              
150 0 0         push(@i2s, @{$enum->{i2s}}[scalar(@i2s)..$#{$enum->{i2s}}]) if ($enum->dirty);
  0            
  0            
151 0           return \@i2s;
152             }
153              
154             ## $enum = $enum->fromArray(\@i2s)
155             ## + clobbers $enum contents, steals \@i2s
156             ## + INHERITED
157              
158             ## $enum = $enum->fromHash(\%s2i)
159             ## + clobbers $enum contents, steals \%s2i
160             ## + INERHITED
161              
162             ## $enum = $enum->fromEnum($enum2)
163             ## + clobbers $enum contents, does NOT steal $enum2->{i2s}
164             ## + INHERITED
165              
166             ## $bool = $enum->load()
167             ## + loads files to memory; must be opened
168             ## + INHERITED
169              
170             ## $enum = $enum->save()
171             ## $enum = $enum->save($base)
172             ## + saves enum to $base; really just a wrapper for open() and flush()
173             ## + INHERITED
174              
175             ##--------------------------------------------------------------
176             ## I/O: header
177             ## + INHERITED
178              
179             ##--------------------------------------------------------------
180             ## I/O: text
181             ## + INHERITED
182              
183             ##==============================================================================
184             ## Methods: population (in-memory only)
185             ## + INHERITED
186              
187             ##==============================================================================
188             ## Methods: lookup
189              
190             ## $s_or_undef = $enum->i2s($i)
191             ## + enum must be opened
192             sub i2s {
193             #my ($enum,$i) = @_;
194 0 0   0 1   return undef if ($_[1] >= $_[0]{size});
195             # return $s if (defined(my $s=$_[0]{i2s}[$_[1]]));
196 0           return substr(${$_[0]{ixbufr}}, $_[1]*$_[0]{len_s}, $_[0]{len_s});
  0            
197             }
198              
199             ## $i_or_undef = $enum->s2i($s)
200             ## $i_or_undef = $enum->s2i($s, $ilo,$ihi)
201             ## + binary search; enum must be opened
202             sub s2i {
203 0     0 1   my ($enum,$key,$ilo,$ihi) = @_;
204              
205 0           my ($sxbufr,$len_s,$len_sx) = @$enum{qw(sxbufr len_s len_sx)};
206 0   0       $ilo //= 0;
207 0 0 0       $ihi //= $enum->{dirty} ? (length($$sxbufr)/$len_sx) : $enum->{size};
208              
209 0           my ($imid,$s,$si);
210             # return $s if (defined($s=$enum->{s2i}{$key}));
211              
212 0           while ($ilo < $ihi) {
213 0           $imid = ($ihi+$ilo) >> 1;
214              
215             ##-- check sx-record @ $imid
216 0 0         if (substr($$sxbufr, $imid*$len_sx, $len_s) lt $key) {
217 0           $ilo = $imid + 1;
218             } else {
219 0           $ihi = $imid;
220             }
221             }
222              
223             ##-- output
224 0 0         if ($ilo==$ihi) {
225             ##-- get sx-record @ $ilo
226 0           ($s,$si) = unpack("A[$len_s]$enum->{pack_i}", substr($$sxbufr, $ilo*$len_sx, $len_sx));
227 0 0         return $si if ($s eq $key);
228             }
229              
230 0           return undef;
231             }
232              
233              
234             ## \@is = $enum->re2i($regex, $pack_s)
235             ## + gets indices for all (packed) strings matching $regex
236             ## + if $pack_s is specified, is will be used to unpack strings (default=$enum->{pack_s}), only the first unpacked element will be tested
237             sub re2i {
238 0     0 1   my ($enum,$re,$pack_s) = @_;
239 0 0         $re = regex($re) if (!ref($re));
240              
241 0   0       $pack_s //= $enum->{pack_s};
242 0           my $i2s = $enum->{i2s};
243              
244 0 0 0       if ($enum->loaded || !$enum->opened) {
245             ##-- easy answer: loaded
246 0 0         if ($pack_s) {
247 0           my ($s);
248 0           return [grep {($s)=unpack($pack_s,$i2s->[$_]); $s =~ $re} [0..$#$i2s]];
  0            
  0            
249             } else {
250 0           return [grep {$i2s->[$_] =~ $re} [0..$#$i2s]];
  0            
251             }
252             }
253              
254             ##-- iteration a la toArray
255 0           my $ixbufr = $enum->{ixbufr};
256 0           my $len_s = $enum->{len_s};
257 0           my $offmax = length($$ixbufr);
258 0           my @is = qw();
259 0           my ($off,$i,$buf);
260 0           for ($off=$i=0; $off < $offmax; $off += $len_s, ++$i) {
261 0           $buf = substr($$ixbufr, $off, $len_s);
262 0 0         ($buf) = unpack($pack_s,$buf) if ($pack_s);
263 0 0         push(@is, $i) if ($buf =~ $re);
264             }
265              
266             ##-- append expansions from in-memory cache
267 0 0         if ($enum->dirty) {
268 0 0         if ($pack_s) {
269 0           my ($s);
270 0           push(@is, grep {($s)=unpack($pack_s,$i2s->[$_]); $s =~ $re} (((-s $enum->{ixfh})/$enum->{len_s})..$#$i2s));
  0            
  0            
271             } else {
272 0           push(@is, grep {$i2s->[$_] =~ $re} (((-s $enum->{ixfh})/$len_s)..$#$i2s));
  0            
273             }
274             }
275 0           return \@is;
276             }
277              
278             ##==============================================================================
279             ## alias: DiaColloDB::EnumFile::FixedLen::MMap
280             package DiaColloDB::EnumFile::FixedLen::MMap;
281             our @ISA = qw(DiaColloDB::EnumFile::FixedMap);
282              
283             ##==============================================================================
284             ## Footer
285             1;
286              
287             __END__
288              
289              
290              
291