File Coverage

blib/lib/DiaColloDB/MultiMapFile/MMap.pm
Criterion Covered Total %
statement 14 55 25.4
branch 0 10 0.0
condition 0 9 0.0
subroutine 6 15 40.0
pod 8 9 88.8
total 28 98 28.5


line stmt bran cond sub pod time code
1             ## -*- Mode: CPerl -*-
2             ## File: DiaColloDB::MultiMapFile::MMap.pm
3             ## Author: Bryan Jurish <moocow@cpan.org>
4             ## Description: collocation db, integer->integer* multimap file, using mmap
5              
6             package DiaColloDB::MultiMapFile::MMap;
7 1     1   9 use DiaColloDB::MultiMapFile;
  1         2  
  1         40  
8 1     1   6 use DiaColloDB::Utils qw(:fcntl :file :json :pack);
  1         3  
  1         85  
9 1     1   440 use File::Map qw(map_handle);
  1         2  
  1         12  
10 1     1   182 use strict;
  1         1  
  1         191  
11              
12             ##==============================================================================
13             ## Globals & Constants
14              
15             our @ISA = qw(DiaColloDB::MultiMapFile);
16              
17             ##==============================================================================
18             ## Constructors etc.
19              
20             ## $mmf = CLASS_OR_OBJECT->new(%args)
21             ## + %args, object structure:
22             ## (
23             ## ##-- MultiMapFile: basic options
24             ## base => $base, ##-- database basename; use files "${base}.ma", "${base}.mb", "${base}.hdr"
25             ## perms => $perms, ##-- default: 0666 & ~umask
26             ## flags => $flags, ##-- default: 'r'
27             ## pack_i => $pack_i, ##-- integer pack template (default='N')
28             ## size => $size, ##-- number of mapped , like scalar(@data)
29             ## ##
30             ## ##-- MultiMapFile: in-memory construction
31             ## a2b => \@a2b, ##-- maps source integers to (packed) target integer-sets: [$a] => pack("${pack_i}*", @bs)
32             ## ##
33             ## ##-- MultiMapFile: computed pack templates and lengths (after open())
34             ## pack_a => $pack_a, ##-- "($pack_i)[2]"
35             ## pack_b => $pack_a, ##-- "($pack_i)*"
36             ## len_i => $len_i, ##-- bytes::length(pack($pack_i,0))
37             ## len_a => $len_a, ##-- bytes::length(pack($pack_a,0))
38             ## ##
39             ## ##-- MultiMapFile: filehandles (after open())
40             ## afh => $afh, ##-- $base.ma : [$a] => pack(${pack_a}, $bidx_a, $blen_a) : $byte_offset_in_bfh = $len_i*$bidx_a
41             ## bfh => $bfh, ##-- $base.mb : $bidx_a : pack(${pack_b}, @targets_for_a) : $byte_length_in_bfh = $len_i*$blen_a
42             ## ##
43             ## ##-- MultiMapFile::MMap: buffers
44             ## abufr => \$abuf, ##-- mmap $base.ma
45             ## bbufr => \$bbuf, ##-- mmap $base.mb
46             ## )
47             sub new {
48 0     0 1   my $that = shift;
49 0           return $that->SUPER::new(
50             #abufr=>undef,
51             #bbufr=>undef,
52             @_, ##-- user arguments
53             )
54             }
55              
56             ##==============================================================================
57             ## I/O
58              
59             ##--------------------------------------------------------------
60             ## I/O: open/close (file)
61              
62             ## $mmf_or_undef = $mmf->open($base,$flags)
63             ## $mmf_or_undef = $mmf->open($base)
64             ## $mmf_or_undef = $mmf->open()
65             sub open {
66 0     0 1   my ($mmf,$base,$flags) = @_;
67 0 0         $mmf->SUPER::open($base,$flags) or return undef;
68 0 0         return $mmf if (!$mmf->isa(__PACKAGE__)); ##-- uh-oh: we were re-blessed out of __PACKAGE__
69 0           return $mmf->remap();
70             }
71              
72             ## $mmf_or_undef = $mmf->remap()
73             ## + mmaps local buffers abufr,bbufr from afh,bfh
74             BEGIN {
75 1     1   133 *mmap_open = \&remap;
76             }
77             sub remap {
78 0     0 1   my $mmf = shift;
79              
80             ##-- mmap handles
81 0           my $mapmode = fcperl($mmf->{flags});
82 0           map_handle(my $abuf, $mmf->{afh}, $mapmode);
83 0           map_handle(my $bbuf, $mmf->{bfh}, $mapmode);
84              
85             ##-- buffers
86 0           $mmf->{abufr} = \$abuf;
87 0           $mmf->{bbufr} = \$bbuf;
88              
89 0           return $mmf;
90             }
91              
92             ## $mmf_or_undef = $mmf->mmap_close()
93             ## + un-references local buffers abufr,bbufr
94             BEGIN {
95 1     1   470 *mmap_close = \&unmap;
96             }
97             sub unmap {
98 0     0 1   my $mmf = shift;
99 0           delete @$mmf{qw(abufr bbufr)};
100 0           return $mmf;
101             }
102              
103              
104             ## $mmf_or_undef = $mmf->close()
105             sub close {
106 0     0 1   my $mmf = shift;
107 0   0       return $mmf->unmap() && $mmf->SUPER::close();
108             }
109              
110             ## $bool = $mmf->opened()
111             sub opened {
112 0     0 1   my $mmf = shift;
113 0   0       return $mmf->SUPER::opened() && defined($mmf->{abufr}) && defined($mmf->{bbufr});
114             }
115              
116             ## $bool = $mmf->reopen()
117             ## + re-opens datafiles
118             ## + override also remaps buffers
119             sub reopen {
120 0     0 0   my $mmf = shift;
121 0   0       return $mmf->SUPER::reopen() && $mmf->remap();
122             }
123              
124              
125             ## $bool = $mmf->dirty()
126             ## + returns true iff some in-memory structures haven't been flushed to disk
127             ## + INHERITED from MultiMapFile
128              
129             ## $bool = $mmf->flush()
130             ## + flush in-memory structures to disk
131             ## + clobbers any old disk-file contents with in-memory maps
132             ## + file must be opened in write-mode
133             ## + invalidates any old references to {a2b} (but doesn't empty them if you need to keep a reference)
134             ## + INHERITED from MultiMapFile
135              
136             ##--------------------------------------------------------------
137             ## I/O: memory <-> file
138              
139             ## \@a2b = $mmf->toArray()
140             sub toArray {
141 0     0 1   my $mmf = shift;
142 0 0         return $mmf->{a2b} if (!$mmf->opened);
143              
144             #use bytes; ##-- deprecated in perl v5.18.2
145 0           my ($abufr,$bbufr,$len_a,$pack_a,$len_i) = @$mmf{qw(abufr bbufr len_a pack_a len_i)};
146 0           my @a2b = qw();
147              
148             ##-- ye olde loope
149 0           my ($aoff,$bidx,$blen);
150 0           my $aend = length($$abufr);
151 0           for ($aoff=0; $aoff < $aend; $aoff += $len_a) {
152 0           ($bidx,$blen) = unpack($pack_a, substr($$abufr, $aoff, $len_a));
153 0           push(@a2b, substr($$bbufr, $bidx*$len_i, $blen*$len_i));
154             }
155              
156 0 0         push(@a2b, @{$mmf->{a2b}}[scalar(@a2b)..$#{$mmf->{a2b}}]) if ($mmf->dirty);
  0            
  0            
157 0           return \@a2b;
158             }
159              
160             ## $mmf = $mmf->fromArray(\@a2b)
161             ## + clobbers $mmf contents, steals \@a2b
162             ## + INHERITED from MultiMapFile
163              
164             ## $bool = $mmf->load()
165             ## + loads files to memory; must be opened
166             ## + INHERITED from MultiMapFile
167              
168             ## $mmf = $mmf->save()
169             ## $mmf = $mmf->save($base)
170             ## + saves multimap to $base; really just a wrapper for open() and flush()
171             ## + INHERITED from MultiMapFile
172              
173             ##--------------------------------------------------------------
174             ## I/O: header
175             ## + see also DiaColloDB::Persistent
176              
177             ## @keys = $coldb->headerKeys()
178             ## + keys to save as header
179             ## + INHERITED from MultiMapFile
180              
181             ## $bool = $CLASS_OR_OBJECT->loadHeader()
182             ## + wraps $CLASS_OR_OBJECT->loadHeaderFile($CLASS_OR_OBJ->headerFile())
183             ## + INHERITED from DiaColloDB::Persistent
184              
185             ## $bool = $mmf->loadHeaderData($hdr)
186             ## + INHERITED from MultiMapFile
187              
188             ## $bool = $enum->saveHeader()
189             ## + inherited from DiaColloDB::Persistent
190              
191             ##--------------------------------------------------------------
192             ## I/O: text
193              
194             ## $bool = $obj->loadTextFile($filename_or_handle, %opts)
195             ## + wraps loadTextFh()
196             ## + INHERITED from DiaColloDB::Persistent
197              
198             ## $mmf = $CLASS_OR_OBJECT->loadTextFh($fh)
199             ## + loads from text file with lines of the form "A B1 B2..."
200             ## + clobbers multimap contents
201             ## + INHERITED from MultiMapFile
202              
203             ## $bool = $obj->saveTextFile($filename_or_handle, %opts)
204             ## + wraps saveTextFh()
205             ## + INHERITED from DiaColloDB::Persistent
206              
207             ## $bool = $mmf->saveTextFh($filename_or_fh,%opts)
208             ## + save from text file with lines of the form "A B1 B2..."
209             ## + %opts:
210             ## a2s=>\&a2s ##-- stringification code for A items, called as $s=$a2s->($bi)
211             ## b2s=>\&b2s ##-- stringification code for B items, called as $s=$b2s->($bi)
212             ## + INHERITED from MultiMapFile
213              
214             ##==============================================================================
215             ## Methods: population (in-memory only)
216              
217             ## $newsize = $mmf->addPairs($a,@bs)
218             ## $newsize = $mmf->addPairs($a,\@bs)
219             ## + adds mappings $a=>$b foreach $b in @bs
220             ## + multimap must be loaded to memory
221             ## + INHERITED from MultiMapFile
222              
223             ##==============================================================================
224             ## Methods: lookup
225              
226             ## $bs_packed = $mmf->fetchraw($a)
227             sub fetchraw {
228 0     0 1   my ($mmf,$a) = @_;
229 0 0         return '' if (!defined($a));
230 0           my ($boff,$blen) = unpack($mmf->{pack_a}, substr(${$mmf->{abufr}}, $a*$mmf->{len_a}, $mmf->{len_a}));
  0            
231 0           return substr(${$mmf->{bbufr}}, $boff*$mmf->{len_i}, $blen*$mmf->{len_i});
  0            
232             }
233              
234             ## \@bs_or_undef = $mmf->fetch($a)
235             ## + returns array \@bs of targets for $a, or undef if not found
236             ## + multimap must be opened
237             ## + INHERITED from MultiMapFile
238              
239             ##==============================================================================
240             ## Footer
241             1;
242              
243             __END__
244              
245              
246              
247