9 |
BEGIN { |
BEGIN { |
10 |
use Exporter (); |
use Exporter (); |
11 |
use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
12 |
$VERSION = 0.08; |
$VERSION = 0.09; |
13 |
@ISA = qw (Exporter); |
@ISA = qw (Exporter); |
14 |
#Give a hoot don't pollute, do not export more than needed by default |
#Give a hoot don't pollute, do not export more than needed by default |
15 |
@EXPORT = qw (); |
@EXPORT = qw (); |
30 |
isisdb => './cds/cds', |
isisdb => './cds/cds', |
31 |
); |
); |
32 |
|
|
33 |
for(my $mfn = 1; $mfn <= $isis->{'maxmfn'}; $mfn++) { |
for(my $mfn = 1; $mfn <= $isis->count; $mfn++) { |
34 |
print $isis->to_ascii($mfn),"\n"; |
print $isis->to_ascii($mfn),"\n"; |
35 |
} |
} |
36 |
|
|
123 |
|
|
124 |
=back |
=back |
125 |
|
|
|
It will also set C<$isis-E<gt>{'maxmfn'}> which is maximum MFN stored in database. |
|
|
|
|
126 |
=cut |
=cut |
127 |
|
|
128 |
sub new { |
sub new { |
197 |
read($self->{'fileMST'}, $buff, 4); |
read($self->{'fileMST'}, $buff, 4); |
198 |
$self->{'NXTMFN'}=unpack("l",$buff) || carp "NXTNFN is zero"; |
$self->{'NXTMFN'}=unpack("l",$buff) || carp "NXTNFN is zero"; |
199 |
|
|
|
# save maximum MFN |
|
|
$self->{'maxmfn'} = $self->{'NXTMFN'} - 1; |
|
|
|
|
200 |
|
|
201 |
|
|
202 |
|
|
208 |
$self ? return $self : return undef; |
$self ? return $self : return undef; |
209 |
} |
} |
210 |
|
|
211 |
|
=head2 count |
212 |
|
|
213 |
|
Return number of records in database |
214 |
|
|
215 |
|
print $isis->count; |
216 |
|
|
217 |
|
=cut |
218 |
|
|
219 |
|
sub count { |
220 |
|
my $self = shift; |
221 |
|
return $self->{'NXTMFN'} - 1; |
222 |
|
} |
223 |
|
|
224 |
=head2 read_cnt |
=head2 read_cnt |
225 |
|
|
226 |
Read content of C<.CNT> file and return hash containing it. |
Read content of C<.CNT> file and return hash containing it. |
242 |
|
|
243 |
open(fileCNT, $self->{cnt_file}) || croak "can't read '$self->{cnt_file}': $!"; |
open(fileCNT, $self->{cnt_file}) || croak "can't read '$self->{cnt_file}': $!"; |
244 |
|
|
|
# There is two 26 Bytes fixed lenght records |
|
|
|
|
|
# 0: IDTYPE BTree type 16 |
|
|
# 2: ORDN Nodes Order 16 |
|
|
# 4: ORDF Leafs Order 16 |
|
|
# 6: N Number of Memory buffers for nodes 16 |
|
|
# 8: K Number of buffers for first level index 16 |
|
|
# 10: LIV Current number of Index Levels 16 |
|
|
# 12: POSRX* Pointer to Root Record in N0x 32 |
|
|
# 16: NMAXPOS* Next Available position in N0x 32 |
|
|
# 20: FMAXPOS* Next available position in L0x 32 |
|
|
# 24: ABNORMAL Formal BTree normality indicator 16 |
|
|
# length: 26 bytes |
|
|
|
|
|
sub unpack_cnt { |
|
|
my $self = shift; |
|
|
|
|
|
my @flds = qw(ORDN ORDF N K LIV POSRX NMAXPOS FMAXPOS ABNORMAL); |
|
|
|
|
|
my $buff = shift || return; |
|
|
my @arr = unpack("ssssssllls", $buff); |
|
|
|
|
|
print STDERR "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'}); |
|
|
|
|
|
my $IDTYPE = shift @arr; |
|
|
foreach (@flds) { |
|
|
$self->{cnt}->{$IDTYPE}->{$_} = abs(shift @arr); |
|
|
} |
|
|
} |
|
|
|
|
245 |
my $buff; |
my $buff; |
246 |
|
|
247 |
read(fileCNT, $buff, 26); |
read(fileCNT, $buff, 26); |
255 |
return $self->{cnt}; |
return $self->{cnt}; |
256 |
} |
} |
257 |
|
|
258 |
|
=head2 unpack_cnt |
259 |
|
|
260 |
|
Unpack one of two 26 bytes fixed length record in C<.CNT> file. |
261 |
|
|
262 |
|
Here is definition of record: |
263 |
|
|
264 |
|
off key description size |
265 |
|
0: IDTYPE BTree type s |
266 |
|
2: ORDN Nodes Order s |
267 |
|
4: ORDF Leafs Order s |
268 |
|
6: N Number of Memory buffers for nodes s |
269 |
|
8: K Number of buffers for first level index s |
270 |
|
10: LIV Current number of Index Levels s |
271 |
|
12: POSRX Pointer to Root Record in N0x l |
272 |
|
16: NMAXPOS Next Available position in N0x l |
273 |
|
20: FMAXPOS Next available position in L0x l |
274 |
|
24: ABNORMAL Formal BTree normality indicator s |
275 |
|
length: 26 bytes |
276 |
|
|
277 |
|
This will fill C<$self> object under C<cnt> with hash. It's used by C<read_cnt>. |
278 |
|
|
279 |
|
=cut |
280 |
|
|
281 |
|
sub unpack_cnt { |
282 |
|
my $self = shift; |
283 |
|
|
284 |
|
my @flds = qw(ORDN ORDF N K LIV POSRX NMAXPOS FMAXPOS ABNORMAL); |
285 |
|
|
286 |
|
my $buff = shift || return; |
287 |
|
my @arr = unpack("ssssssllls", $buff); |
288 |
|
|
289 |
|
print STDERR "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'}); |
290 |
|
|
291 |
|
my $IDTYPE = shift @arr; |
292 |
|
foreach (@flds) { |
293 |
|
$self->{cnt}->{$IDTYPE}->{$_} = abs(shift @arr); |
294 |
|
} |
295 |
|
} |
296 |
|
|
297 |
=head2 fetch |
=head2 fetch |
298 |
|
|
299 |
Read record with selected MFN |
Read record with selected MFN |