1 |
ulpfr |
10 |
# -*- Mode: Perl -*- |
2 |
|
|
# Scan.pm -- |
3 |
|
|
# ITIID : $ITI$ $Header $__Header$ |
4 |
|
|
# Author : Ulrich Pfeifer |
5 |
|
|
# Created On : Mon Aug 12 14:05:14 1996 |
6 |
|
|
# Last Modified By: Ulrich Pfeifer |
7 |
|
|
# Last Modified On: Sun Nov 22 18:44:39 1998 |
8 |
|
|
# Language : CPerl |
9 |
|
|
# Update Count : 56 |
10 |
|
|
# Status : Unknown, Use with caution! |
11 |
|
|
# |
12 |
|
|
# Copyright (c) 1996-1997, Ulrich Pfeifer |
13 |
|
|
# |
14 |
|
|
|
15 |
|
|
package WAIT::Scan; |
16 |
|
|
|
17 |
|
|
use strict; |
18 |
|
|
use Carp; |
19 |
|
|
use DB_File; |
20 |
|
|
use Fcntl; |
21 |
|
|
|
22 |
|
|
sub new { |
23 |
|
|
my $type = shift; |
24 |
|
|
my $table = shift; |
25 |
|
|
my $last = shift; |
26 |
|
|
my $code = shift; |
27 |
|
|
my ($first, $value); |
28 |
|
|
|
29 |
|
|
bless {table => $table, code => $code, |
30 |
|
|
nextk => 1, lastk => $last}, $type or ref($type); |
31 |
|
|
} |
32 |
|
|
|
33 |
|
|
sub _next { |
34 |
|
|
my $self = shift; |
35 |
|
|
|
36 |
|
|
return () if $self->{nextk} > $self->{lastk}; |
37 |
|
|
|
38 |
|
|
# Access to parents deleted list is no good idea. But we want to |
39 |
|
|
# avoid to copy result of $self->{table}->fetch($self->{nextk}++) |
40 |
|
|
# just to check if we neet to inclrement $self->{nextk} |
41 |
|
|
|
42 |
|
|
while (defined $self->{table}->{deleted}->{$self->{nextk}}) { |
43 |
|
|
$self->{nextk}++; |
44 |
|
|
return () if $self->{nextk} > $self->{lastk}; |
45 |
|
|
} |
46 |
|
|
$self->{table}->fetch($self->{nextk}++); |
47 |
|
|
} |
48 |
|
|
|
49 |
|
|
sub next { |
50 |
|
|
my $self = shift; |
51 |
|
|
|
52 |
|
|
unless ($self->{code}) { |
53 |
|
|
$self->_next; |
54 |
|
|
} else { |
55 |
|
|
my %tp = $self->_next; |
56 |
|
|
if (%tp) { |
57 |
|
|
if (&{$self->{code}}(\%tp)) { |
58 |
|
|
%tp; |
59 |
|
|
} else { |
60 |
|
|
$self->next; |
61 |
|
|
} |
62 |
|
|
} else { |
63 |
|
|
return (); |
64 |
|
|
} |
65 |
|
|
} |
66 |
|
|
} |
67 |
|
|
|
68 |
|
|
sub close { undef $_[0]} # force DESTROY |
69 |
|
|
|
70 |
|
|
1; |