File Coverage

blib/lib/DiaColloDB/Persistent.pm
Criterion Covered Total %
statement 15 93 16.1
branch 0 38 0.0
condition 0 18 0.0
subroutine 9 40 22.5
pod 29 31 93.5
total 53 220 24.0


line stmt bran cond sub pod time code
1             ## -*- Mode: CPerl -*-
2             ## File: DiaColloDB::Persistent.pm
3             ## Author: Bryan Jurish <moocow@cpan.org>
4             ## Description: collocation db, persistent objects
5              
6              
7             package DiaColloDB::Persistent;
8 2     2   1138 use DiaColloDB::Utils qw(:list);
  2         4  
  2         316  
9 2     2   16 use IO::File;
  2         4  
  2         234  
10 2     2   12 use strict;
  2         4  
  2         1696  
11              
12             ##==============================================================================
13             ## Globals & Constants
14              
15             our @ISA = qw(DiaColloDB::Logger);
16              
17             ##==============================================================================
18             ## mmap usage
19              
20             ## $CLASS = $obj->mmclass($CLASSNAME) : respects $obj->{mmap} option
21             sub mmclass {
22 0     0 0   my ($that,$class) = @_;
23 0 0 0       $class =~ s/::MMap$//i if (ref($that) && !($that->{mmap}//1));
      0        
24 0           return $class;
25             }
26              
27              
28             ##==============================================================================
29             ## disk usage, timestamp
30              
31             ## @files = $obj->diskFiles()
32             ## + returns disk storage files, used by du() and timestamp()
33             ## + default implementation returns $obj->{file} or glob("$obj->{base}*")
34             sub diskFiles {
35 0     0 1   my $obj = shift;
36 0 0         return ($obj->{file}) if ($obj->{file});
37 0 0         return glob("$obj->{base}*") if ($obj->{base});
38 0           return qw();
39             }
40              
41             ## $nbytes = $obj->du()
42             ## + default implementation wraps DiaColloDB::Utils::du_file($obj->diskFiles)
43             sub du {
44 0     0 1   return DiaColloDB::Utils::du_file($_[0]->diskFiles);
45             }
46              
47             ## $mtime = $obj->mtime()
48             ## + default returns newest mtime for $obj->diskFiles()
49             sub mtime {
50 0     0 1   my $obj = shift;
51 0           my $mtime = 0;
52 0           foreach (map {DiaColloDB::Utils::file_mtime($_)} $obj->diskFiles) {
  0            
53 0 0         $mtime = $_ if ($_ > $mtime);
54             }
55 0           return $mtime;
56             }
57              
58             ## $timestamp = $obj->timestamp()
59             ## + default returns timestamp for $obj->mtime()
60             sub timestamp {
61 0     0 1   return DiaColloDB::Utils::timestamp($_[0]->mtime);
62             }
63              
64             ## $bool = $obj->unlink()
65             ## + unlinks disk files
66             ## + implcitly calls $obj->close() if available
67             sub unlink {
68 0     0 1   my $obj = shift;
69 0           my @files = $obj->diskFiles();
70 0 0         $obj->close() if ($obj->can('close'));
71 0           CORE::unlink(grep {-e $_} @files);
  0            
72             }
73              
74             ## $bool = $obj->copyto($todir, %opts)
75             ## + copies object file(s) to $todir, creating $todir if it doesn't already exist;
76             ## options %opts:
77             ## (
78             ## method => \&method, ##-- use CODE-ref \&method(\@srcfiles,$todir,%opts) to copy file(s) (default=\&DiaColloDB::Utils::copyto)
79             ## close => $bool, ##-- implicitly close() object before operation? (default=0)
80             ## ... ##-- other options are passed to \&method
81             ## )
82             sub copyto {
83 0     0 1   my ($obj,$todir,%opts) = @_;
84 0   0       my $method = $opts{method} || \&DiaColloDB::Utils::copyto;
85 0           my @files = $obj->diskFiles();
86 0 0 0       $obj->close() if ($opts{close} && $obj->can('close'));
87 0           return $method->(\@files, $todir, %opts);
88             }
89              
90             ## $bool = $obj->copyto_a($todir, %opts)
91             ## + wrapper for copyto() which propagates timestamps, ownership, and permissions
92             sub copyto_a {
93 0     0 1   return $_[0]->copyto(@_[1..$#_], method=>\&DiaColloDB::Utils::copyto_a);
94             }
95              
96             ## $bool = $obj->moveto($todir, %opts)
97             ## + wrapper for $obj->copyto($todir, %opts, method=>\&DiaColloDB::Utils::moveto, close=>1);
98             sub moveto {
99 0     0 1   return $_[0]->copyto(@_[1..$#_], method=>\&DiaColloDB::Utils::moveto, close=>1);
100             }
101              
102             ##==============================================================================
103             ## IO
104              
105             ##--------------------------------------------------------------
106             ## I/O: Header
107              
108             ## @keys = $obj->headerKeys()
109             ## + keys to save as header; default implementation returns all keys of all non-references
110             sub headerKeys {
111 0     0 1   return grep {!ref($_[0]{$_})} keys %{$_[0]};
  0            
  0            
112             }
113              
114             ## $hdr = $obj->headerData()
115             ## + returns reference to object header data; default returns anonymous HASH-ref for $obj->headerKeys()
116             sub headerData {
117 0   0 0 1   return {(map {($_=>$_[0]->{$_})} $_[0]->headerKeys), %{$_[0]->headerDataExtra//{}}};
  0            
  0            
118             }
119              
120             ## $extra = $obj->headerDataExtra()
121             ## + returns extra data for inclusion in default headerData() HASH-ref
122             sub headerDataExtra {
123 0     0 0   return {class=>ref($_[0])};
124             }
125              
126             ## $filename = $obj->headerFile()
127             ## + returns header filename; default returns "$obj->{base}.hdr" or "$obj->{dbdir}/header.json"
128             sub headerFile {
129 0 0   0 1   return undef if (!ref($_[0]));
130 0 0         return "$_[0]{dbdir}/header.json" if (defined($_[0]{dbdir}));
131 0 0         return "$_[0]{base}.hdr" if (defined($_[0]{base}));
132 0 0         return "$_[0]{file}.hdr" if (defined($_[0]{file}));
133 0           return undef;
134             }
135              
136             ## $str = $obj->saveHeaderString(%opts)
137             ## + returns JSON string for object header data
138             sub saveHeaderString {
139 0     0 1   return DiaColloDB::Utils::saveJsonString($_[0]->headerData, @_[1..$#_]);
140             }
141              
142             ## $bool = $obj->saveHeaderFh($fh, %opts)
143             BEGIN {
144 2     2   548 *saveHeaderFh = \&saveHeaderFile;
145             }
146              
147             ## $bool = $obj->saveHeaderFile($filename_or_handle, %opts)
148             sub saveHeaderFile {
149 0     0 1   return DiaColloDB::Utils::saveJsonFile($_[0]->headerData, @_[1..$#_]);
150             }
151              
152             ## $bool = $obj->saveHeader()
153             ## $bool = $obj->saveHeader($headerFile,%opts)
154             ## + wraps $obj->saveHeaderFile($headerFile//$obj->headerFile(), %opts)
155             sub saveHeader {
156 0   0 0 1   $_[0]->saveHeaderFile(($_[1]//$_[0]->headerFile()), @_[2..$#_]);
157             }
158              
159             ##--
160              
161             ## $obj = $CLASS_OR_OBJECT->loadHeaderData($data_or_undef)
162             ## + instantiates header data from $data
163             ## + default just sets @$obj{keys %$data} = values %$data and clobbers $obj->{class}=ref($obj)
164             sub loadHeaderData {
165 0     0 1   my ($that,$hdr) = @_;
166 0 0         $that->logconfess("loadHeaderData(): header data undefined") if (!defined($hdr));
167 0 0         $that = $that->new() if (!ref($that));
168 0           @$that{keys %$hdr} = values %$hdr;
169 0           $that->{class} = ref($that);
170 0           return $that;
171             }
172              
173             ## $obj = $CLASS_OR_OBJECT->loadHeaderString( $string,%opts)
174             ## $obj = $CLASS_OR_OBJECT->loadHeaderString(\$string,%opts)
175             ## + loads header data from JSON string $string
176             ## + wraps $CLASS_OR_OBJECT->loadHeaderData()
177             sub loadHeaderString {
178 0     0 1   return $_[0]->loadHeaderData(DiaColloDB::Utils::loadJsonString(@_[1..$#_]));
179             }
180              
181             ## $hdr = $CLASS_OR_OBJECT->readHeaderFh($fh, %opts)
182             BEGIN {
183 2     2   264 *readHeaderFh = *readHeaderFile;
184             }
185              
186             ## $hdr = $CLASS_OR_OBJECT->readHeaderFile($filename_or_handle, %opts)
187             ## + wraps DiaColloDB::Utils::loadJsonFile()
188             sub readHeaderFile {
189 0     0 1   return DiaColloDB::Utils::loadJsonFile(@_[1..$#_]);
190             }
191              
192             ## $hdr = $CLASS_OR_OBJECT->readHeader()
193             ## $hdr = $CLASS_OR_OBJECT->readHeader($headerFile,%opts)
194             ## + wraps $CLASS_OR_OBJECT->readHeaderFile($headerFile//$CLASS_OR_OBJ->headerFile())
195             sub readHeader {
196 0   0 0 1   return $_[0]->readHeaderFile(($_[1]//$_[0]->headerFile), @_[2..$#_]);
197             }
198              
199             ## $obj = $CLASS_OR_OBJECT->loadHeaderFh($fh, %opts)
200             BEGIN {
201 2     2   134 *loadHeaderFh = \&loadHeaderFile;
202             }
203              
204             ## $obj = $CLASS_OR_OBJECT->loadHeaderFile()
205             ## $obj = $CLASS_OR_OBJECT->loadHeaderFile($filename_or_handle, %opts)
206             ## + wraps $CLASS_OR_OBJECT->loadHeaderData($CLASS_OR_OBJECT->readHeader($filename_or_handle, %opts))
207             sub loadHeaderFile {
208 0     0 1   return $_[0]->loadHeaderData($_[0]->readHeader(@_[1..$#_]));
209             }
210              
211             ## $bool = $CLASS_OR_OBJECT->loadHeader()
212             ## $bool = $CLASS_OR_OBJECT->loadHeader($headerFile,%opts)
213             ## + alias for loadHeaderFile()
214             BEGIN {
215 2     2   176 *loadHeader = \&loadHeaderFile;
216             }
217              
218             ##--------------------------------------------------------------
219             ## I/O: JSON
220              
221             ## $thingy = $obj->TO_JSON()
222             ## + JSON module wrapper; default just returns anonymous HASH-ref
223             sub TO_JSON {
224 0     0 1   return { %{$_[0]} };
  0            
225             }
226              
227             ## $str = $obj->saveJsonString(%opts)
228             sub saveJsonString {
229 0     0 1   return DiaColloDB::Utils::saveJsonString(@_);
230             }
231              
232             ## $bool = $obj->saveJsonFh($fh, %opts)
233             BEGIN {
234 2     2   296 *saveJsonFh = \&saveJsonFile;
235             }
236              
237             ## $bool = $obj->saveJsonFile($filename_or_handle, %opts)
238             sub saveJsonFile {
239 0     0 1   return DiaColloDB::Utils::saveJsonFile(@_);
240             }
241              
242             ## $obj = $CLASS_OR_OBJECT->loadJsonData( $data,%opts)
243             ## + guts for loadJsonString(), loadJsonFile()
244             sub loadJsonData {
245 0     0 1   my ($that,$data) = @_;
246 0 0         return bless($data,$that) if (!ref($that));
247 0           %$that = %$data;
248 0           return $that;
249             }
250              
251             ## $obj = $CLASS_OR_OBJECT->loadJsonString( $string,%opts)
252             ## $obj = $CLASS_OR_OBJECT->loadJsonString(\$string,%opts)
253             sub loadJsonString {
254 0     0 1   my $that = shift;
255 0           return $that->loadJsonData(DiaColloDB::Utils::loadJsonString(@_));
256             }
257              
258             ## $obj = $CLASS_OR_OBJECT->loadJsonFh($fh,%opts)
259             BEGIN {
260 2     2   688 *loadJsonFh = \&loadJsonFile;
261             }
262              
263             ## $obj = $CLASS_OR_OBJECT->loadJsonFile($filename_or_handle,%opts)
264             sub loadJsonFile {
265 0     0 1   my $that = shift;
266 0           return $that->loadJsonData(DiaColloDB::Utils::loadJsonFile(@_));
267             }
268              
269             ##--------------------------------------------------------------
270             ## I/O: Text
271              
272             ## $bool = $obj->saveTextFh($fh, %opts)
273             ## + save text representation to a filehandle (dummy)
274             sub saveTextFh {
275 0     0 1   $_[0]->logconfess("saveTextFh() not implemented");
276             }
277              
278             ## $bool = $obj->saveTextFile($filename_or_handle, %opts)
279             ## + wraps saveTextFh()
280             sub saveTextFile {
281 0     0 1   my ($obj,$file,@args) = @_;
282 0 0         my $fh = ref($file) ? $file : IO::File->new(">$file");
283 0 0         $obj->logconfess("saveTextFile(): failed to open '$file': $!") if (!ref($fh));
284 0           my $rc = $obj->saveTextFh($fh,@args);
285 0 0         $fh->close() if (!ref($file));
286 0           return $rc;
287             }
288              
289             ## $obj = $CLASS_OR_OBJECT->loadTextFh($fh, %opts)
290             ## + load object from a text filehandle (dummy)
291             sub loadTextFh {
292 0     0 1   $_[0]->logconfess("loadTextFh() not implemented");
293             }
294              
295             ## $bool = $CLASS_OR_OBJECT->loadTextFile($filename_or_handle, %opts)
296             ## + wraps loadTextFh()
297             sub loadTextFile {
298 0     0 1   my ($that,$file,@args) = @_;
299 0 0         my $fh = ref($file) ? $file : IO::File->new("<$file");
300 0 0         $that->logconfess("loadTextFile(): failed to open '$file': $!") if (!ref($fh));
301 0           my $obj = $that->loadTextFh($fh,@args);
302 0 0         $fh->close() if (!ref($file));
303 0           return $obj;
304             }
305              
306              
307             ##==============================================================================
308             ## Footer
309             1;
310              
311             __END__