| 4 |
# Author : Ulrich Pfeifer |
# Author : Ulrich Pfeifer |
| 5 |
# Created On : Mon Aug 12 14:05:14 1996 |
# Created On : Mon Aug 12 14:05:14 1996 |
| 6 |
# Last Modified By: Ulrich Pfeifer |
# Last Modified By: Ulrich Pfeifer |
| 7 |
# Last Modified On: Sat Apr 27 17:46:53 2002 |
# Last Modified On: Sun Nov 22 18:44:43 1998 |
| 8 |
# Language : CPerl |
# Language : CPerl |
| 9 |
# Update Count : 92 |
# Update Count : 65 |
| 10 |
# Status : Unknown, Use with caution! |
# Status : Unknown, Use with caution! |
| 11 |
# |
# |
| 12 |
# Copyright (c) 1996-1997, Ulrich Pfeifer |
# Copyright (c) 1996-1997, Ulrich Pfeifer |
| 15 |
package WAIT::IndexScan; |
package WAIT::IndexScan; |
| 16 |
|
|
| 17 |
use strict; |
use strict; |
| 18 |
use BerkeleyDB; |
use DB_File; |
| 19 |
use Fcntl; |
use Fcntl; |
| 20 |
|
|
| 21 |
sub new { |
sub new { |
| 22 |
my $type = shift; |
my $type = shift; |
| 23 |
my $index = shift; |
my $index = shift; |
| 24 |
my $code = shift; |
my $code = shift; |
| 25 |
my $cursor; |
my ($first, $tid) = ('', ''); |
| 26 |
|
|
| 27 |
# find the first key |
# find the first key |
| 28 |
unless ($cursor = $index->{dbh}->db_cursor()) { |
if ($index->{dbh}->seq($first, $tid, R_FIRST)) { |
| 29 |
require Carp; |
require Carp; |
| 30 |
Carp::croak("Could not open scan"); |
Carp::croak("Could not open scan"); |
| 31 |
} |
} |
| 32 |
# Not sure about this. DB_FIRST sets $tid to no-of-records? |
# Not sure about this. R_FIRST sets $tid to no-of-records? |
| 33 |
# $index->{dbh}->seq($first, $tid, DB_NEXT); |
# $index->{dbh}->seq($first, $tid, R_NEXT); |
| 34 |
# register to avoid unnecessary position calls |
# register to avoid unnecessary position calls |
| 35 |
|
$index->{scans}++; |
| 36 |
|
|
| 37 |
bless {code => $code, cursor => $cursor, Index => $index}, |
bless {Index => $index, code => $code, |
| 38 |
$type or ref($type); |
nextk => $first, tid => $tid}, $type or ref($type); |
| 39 |
} |
} |
| 40 |
|
|
| 41 |
sub next { |
sub next { |
| 42 |
my $self = shift; |
my $self = shift; |
| 43 |
my $cursor = $self->{cursor}; |
my $dbh = $self->{Index}->{dbh}; |
| 44 |
my ($key, $tid) = ('', ''); |
my ($key, $tid, $ntid); |
| 45 |
|
|
| 46 |
$cursor->c_get($key, $tid, DB_NEXT) == 0 or return; |
if (defined $self->{nextk}) { |
| 47 |
|
unless ($dbh){ |
| 48 |
my @tuple = split /$;/, $key; |
require Carp; |
| 49 |
|
Carp::croak("Cannot scan closed index"); |
| 50 |
my %tuple = (_id => $tid); |
} |
| 51 |
for (@{$self->{Index}->{attr}}) { |
$key = $self->{nextk}; |
| 52 |
$tuple{$_} = shift @tuple; |
|
| 53 |
} |
if ($self->{Index}->{scans} > 1) { |
| 54 |
|
# Another scan is open. Reset the cursor |
| 55 |
|
$dbh->seq($key, $tid, R_CURSOR); |
| 56 |
if ($self->{code}) { # test condition |
} else { |
| 57 |
&{$self->{code}}(\%tuple)? %tuple : $self->next; |
$tid = $self->{tid}; |
| 58 |
|
} |
| 59 |
|
if ($dbh->seq($self->{nextk}, $self->{tid}, R_NEXT)) { |
| 60 |
|
# current tuple is last one |
| 61 |
|
delete $self->{nextk}; |
| 62 |
|
} |
| 63 |
|
|
| 64 |
|
my @tuple = split /$;/, $key; |
| 65 |
|
my %tuple = (_id => $tid); |
| 66 |
|
for (@{$self->{Index}->{attr}}) { |
| 67 |
|
$tuple{$_} = shift @tuple; |
| 68 |
|
} |
| 69 |
|
|
| 70 |
|
if ($self->{code}) { # test condition |
| 71 |
|
&{$self->{code}}(\%tuple)? %tuple : $self->next; |
| 72 |
|
} else { |
| 73 |
|
%tuple; |
| 74 |
|
} |
| 75 |
} else { |
} else { |
| 76 |
%tuple; |
return; |
| 77 |
} |
} |
| 78 |
} |
} |
| 79 |
|
|
| 80 |
sub close { |
sub close { undef $_[0]} # force DESTROY |
| 81 |
my $self = shift; |
sub DESTROY { |
| 82 |
delete $self->{cursor}; |
shift->{Index}->{scans}--; |
| 83 |
} |
} |
| 84 |
|
|
| 85 |
1; |
1; |
Parent Directory
| 
Revision Log
| 
Patch