7 |
BEGIN { |
BEGIN { |
8 |
use Exporter (); |
use Exporter (); |
9 |
use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
10 |
$VERSION = 0.05; |
$VERSION = 0.06; |
11 |
@ISA = qw (Exporter); |
@ISA = qw (Exporter); |
12 |
#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 |
13 |
@EXPORT = qw (); |
@EXPORT = qw (); |
210 |
my $buff = shift || return; |
my $buff = shift || return; |
211 |
my @arr = unpack("ssssssllls", $buff); |
my @arr = unpack("ssssssllls", $buff); |
212 |
|
|
213 |
print "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'}); |
print STDERR "unpack_cnt: ",join(" ",@arr),"\n" if ($self->{'debug'}); |
214 |
|
|
215 |
my $IDTYPE = shift @arr; |
my $IDTYPE = shift @arr; |
216 |
foreach (@flds) { |
foreach (@flds) { |
227 |
|
|
228 |
close(fileCNT); |
close(fileCNT); |
229 |
|
|
230 |
print Dumper($self),"\n" if ($self->{debug}); |
print STDERR Dumper($self),"\n" if ($self->{debug}); |
231 |
|
|
232 |
# open files for later |
# open files for later |
233 |
open($self->{'fileXRF'}, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!"; |
open($self->{'fileXRF'}, $self->{isisdb}.".XRF") || croak "can't open '$self->{isisdb}.XRF': $!"; |
258 |
|
|
259 |
my $mfn = shift || croak "fetch needs MFN as argument!"; |
my $mfn = shift || croak "fetch needs MFN as argument!"; |
260 |
|
|
261 |
print "fetch: $mfn\n" if ($self->{debug}); |
# is mfn allready in memory? |
262 |
|
my $old_mfn = $self->{'current_mfn'} || -1; |
263 |
|
return if ($mfn == $old_mfn); |
264 |
|
|
265 |
|
print STDERR "## fetch: $mfn\n" if ($self->{debug}); |
266 |
|
|
267 |
# XXX check this? |
# XXX check this? |
268 |
my $mfnpos=($mfn+int(($mfn-1)/127))*4; |
my $mfnpos=($mfn+int(($mfn-1)/127))*4; |
269 |
|
|
270 |
print "seeking to $mfnpos in file '$self->{isisdb}.XRF'\n" if ($self->{debug}); |
print STDERR "## seeking to $mfnpos in file '$self->{isisdb}.XRF'\n" if ($self->{debug}); |
271 |
seek($self->{'fileXRF'},$mfnpos,0); |
seek($self->{'fileXRF'},$mfnpos,0); |
272 |
|
|
273 |
my $buff; |
my $buff; |
279 |
my $XRFMFB = int($pointer/2048); |
my $XRFMFB = int($pointer/2048); |
280 |
my $XRFMFP = $pointer - ($XRFMFB*2048); |
my $XRFMFP = $pointer - ($XRFMFB*2048); |
281 |
|
|
|
print "XRFMFB: $XRFMFB XRFMFP: $XRFMFP\n" if ($self->{debug}); |
|
282 |
|
|
283 |
# XXX fix this to be more readable!! |
# (XRFMFB - 1) * 512 + XRFMFP |
284 |
# e.g. (XRFMFB - 1) * 512 + XRFMFP |
# why do i have to do XRFMFP % 1024 ? |
285 |
|
|
286 |
my $offset = $pointer; |
my $blk_off = (($XRFMFB - 1) * 512) + ($XRFMFP % 1024); |
|
my $offset2=int($offset/2048)-1; |
|
|
my $offset22=int($offset/4096); |
|
|
my $offset3=$offset-($offset22*4096); |
|
|
if ($offset3>512) { |
|
|
$offset3=$offset3-2048; |
|
|
} |
|
|
my $offset4=($offset2*512)+$offset3; |
|
287 |
|
|
288 |
print "$offset - $offset2 - $offset3 - $offset4\n" if ($self->{debug}); |
print STDERR "## pointer: $pointer XRFMFB: $XRFMFB XRFMFP: $XRFMFP offset: $blk_off\n" if ($self->{'debug'}); |
289 |
|
|
290 |
# Get Record Information |
# Get Record Information |
291 |
|
|
292 |
seek($self->{'fileMST'},$offset4,0); |
seek($self->{'fileMST'},$blk_off,0); |
293 |
|
|
294 |
read($self->{'fileMST'}, $buff, 4); |
read($self->{'fileMST'}, $buff, 4); |
295 |
my $value=unpack("l",$buff); |
my $value=unpack("l",$buff); |
296 |
|
|
297 |
|
print STDERR "## offset for rowid $value is $blk_off (blk $XRFMFB off $XRFMFP)\n" if ($self->{debug}); |
298 |
|
|
299 |
if ($value!=$mfn) { |
if ($value!=$mfn) { |
300 |
print ("Error: The MFN:".$mfn." is not found in MST(".$value.")"); |
carp "Error: MFN ".$mfn." not found in MST(".$value.")"; |
301 |
return -1; # XXX deleted record? |
#return; # XXX deleted record? |
302 |
} |
} |
303 |
|
|
304 |
# $MFRL=$self->Read16($fileMST); |
# $MFRL=$self->Read16($fileMST); |
312 |
|
|
313 |
my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff); |
my ($MFRL,$MFBWB,$MFBWP,$BASE,$NVF,$STATUS) = unpack("slssss", $buff); |
314 |
|
|
315 |
print "MFRL: $MFRL MFBWB: $MFBWB MFBWP: $MFBWP BASE: $BASE NVF: $NVF STATUS: $STATUS\n" if ($self->{debug}); |
print STDERR "## MFRL: $MFRL MFBWB: $MFBWB MFBWP: $MFBWP BASE: $BASE NVF: $NVF STATUS: $STATUS\n" if ($self->{debug}); |
316 |
|
|
317 |
# delete old record |
# delete old record |
318 |
delete $self->{record}; |
delete $self->{record}; |
319 |
|
|
320 |
|
## FIXME this is a bug |
321 |
if (! $self->{'include_deleted'} && $MFRL < 0) { |
if (! $self->{'include_deleted'} && $MFRL < 0) { |
322 |
print "## logically deleted record $mfn, skipping...\n" if ($self->{debug}); |
print "## logically deleted record $mfn, skipping...\n" if ($self->{debug}); |
323 |
return; |
return; |
324 |
} |
} |
325 |
|
|
326 |
|
warn "BASE is not 18+6*NVF" unless ($BASE == 18 + 6 * $NVF); |
327 |
|
|
328 |
# Get Directory Format |
# Get Directory Format |
329 |
|
|
330 |
my @FieldPOS; |
my @FieldPOS; |
333 |
|
|
334 |
read($self->{'fileMST'}, $buff, 6 * $NVF); |
read($self->{'fileMST'}, $buff, 6 * $NVF); |
335 |
|
|
336 |
my $fld_len = 0; |
my $rec_len = 0; |
337 |
|
|
338 |
for (my $i = 0 ; $i < $NVF ; $i++) { |
for (my $i = 0 ; $i < $NVF ; $i++) { |
339 |
|
|
343 |
|
|
344 |
my ($TAG,$POS,$LEN) = unpack("sss", substr($buff,$i * 6, 6)); |
my ($TAG,$POS,$LEN) = unpack("sss", substr($buff,$i * 6, 6)); |
345 |
|
|
346 |
print "TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug}); |
print STDERR "## TAG: $TAG POS: $POS LEN: $LEN\n" if ($self->{debug}); |
347 |
|
|
348 |
# The TAG does not exists in .FDT so we set it to 0. |
# The TAG does not exists in .FDT so we set it to 0. |
349 |
# |
# |
359 |
push @FieldPOS,$POS; |
push @FieldPOS,$POS; |
360 |
push @FieldLEN,$LEN; |
push @FieldLEN,$LEN; |
361 |
|
|
362 |
$fld_len += $LEN; |
$rec_len += $LEN; |
363 |
} |
} |
364 |
|
|
365 |
# Get Variable Fields |
# Get Variable Fields |
366 |
|
|
367 |
read($self->{'fileMST'},$buff,$fld_len); |
read($self->{'fileMST'},$buff,$rec_len); |
368 |
|
|
369 |
|
print STDERR "## rec_len: $rec_len poc: ",tell($self->{'fileMST'})."\n" if ($self->{debug}); |
370 |
|
|
371 |
for (my $i = 0 ; $i < $NVF ; $i++) { |
for (my $i = 0 ; $i < $NVF ; $i++) { |
372 |
# skip zero-sized fields |
# skip zero-sized fields |
376 |
} |
} |
377 |
close(fileMST); |
close(fileMST); |
378 |
|
|
379 |
|
$self->{'current_mfn'} = $mfn; |
380 |
|
|
381 |
print Dumper($self),"\n" if ($self->{debug}); |
print Dumper($self),"\n" if ($self->{debug}); |
382 |
|
|
383 |
return $self->{'record'}; |
return $self->{'record'}; |
472 |
my $mfn = shift || confess "need mfn!"; |
my $mfn = shift || confess "need mfn!"; |
473 |
|
|
474 |
# init record to include MFN as field 000 |
# init record to include MFN as field 000 |
475 |
my $rec = { '000' => $mfn }; |
my $rec = { '000' => [ $mfn ] }; |
476 |
|
|
477 |
my $row = $self->fetch($mfn); |
my $row = $self->fetch($mfn); |
478 |
|
|