1# A simple iterator on a Stone.
2package Stone::Cursor;
3
4=head1 NAME
5
6Stone::Cursor - Traverse tags and values of a Stone
7
8=head1 SYNOPSIS
9
10 use Boulder::Store;
11$store = Boulder::Store->new('./soccer_teams');
12
13 my $stone = $store->get(28);
14 $cursor = $stone->cursor;
15 while (my ($key,$value) = $cursor->each) {
16   print "$value: Go Bluejays!\n" if $key eq 'State' and $value eq 'Katonah';
17 }
18
19=head1 DESCRIPTION
20
21Boulder::Cursor is a utility class that allows you to create one or
22more iterators across a L<Stone> object.  This is used for traversing
23large Stone objects in order to identify or modify portions of the
24record.
25
26=head2 CLASS METHODS
27
28=item Boulder::Cursor->new($stone)
29
30Return a new Boulder::Cursor over the specified L<Stone> object.  This
31will return an error if the object is not a L<Stone> or a
32descendent. This method is usually not called directly, but rather
33indirectly via the L<Stone> cursor() method:
34
35  my $cursor = $stone->cursor;
36
37=head2 OBJECT METHODS
38
39=item $cursor->each()
40
41Iterate over the attached B<Stone>.  Each iteration will return a
42two-valued list consisting of a tag path and a value.  The tag path is
43of a form that can be used with B<Stone::index()> (in fact, a cursor
44is used internally to implement the B<Stone::dump()> method.  When the
45end of the B<Stone> is reached, C<each()> will return an empty list,
46after which it will start over again from the beginning.  If you
47attempt to insert or delete from the stone while iterating over it,
48all attached cursors will reset to the beginnning.
49
50For example:
51
52	$cursor = $s->cursor;
53	while (($key,$value) = $cursor->each) {
54           print "$value: BOW WOW!\n" if $key=~/pet/;
55	}
56
57=item $cursor->reset()
58
59This resets the cursor back to the beginning of the associated
60B<Stone>.
61
62=head1 AUTHOR
63
64Lincoln D. Stein <lstein@cshl.org>.
65
66=head1 COPYRIGHT
67
68Copyright 1997-1999, Cold Spring Harbor Laboratory, Cold Spring Harbor
69NY.  This module can be used and distributed on the same terms as Perl
70itself.
71
72=head1 SEE ALSO
73
74L<Boulder>, L<Stone>
75
76=cut
77
78
79#------------------- Boulder::Cursor---------------
80
81
82*next_pair = \&each;
83
84# New expects a Stone object as its single
85# parameter.
86sub new {
87    my($package,$stone) = @_;
88    die "Boulder::Cursor: expect a Stone object parameter"
89	unless ref($stone);
90
91    my $self = bless {'stone'=>$stone},$package;
92    $self->reset;
93    $stone->_register_cursor($self,'true');
94    return $self;
95}
96
97# This procedure does a breadth-first search
98# over the entire structure.  It returns an array that looks like this
99# (key1[index1].key2[index2].key3[index3],value)
100sub each {
101  my $self = shift;
102  my $short_keys = shift;
103
104  my $stack = $self->{'stack'};
105
106  my($found,$key,$value);
107  my $top = $stack->[$#{$stack}];
108  while ($top && !$found) {
109    $found++ if ($key,$value) = $top->next;
110    if (!$found) {		# this iterator is done
111      pop @{$stack};
112      $top = $stack->[$#{$stack}];
113      next;
114    }
115    if ( ref $value && !exists $value->{'.name'} ) { # found another record to begin iterating on
116      if (%{$value}) {
117	undef $found;
118	$top = $value->cursor;
119	push @{$stack},$top;
120	next;
121      } else {
122	undef $value;
123      }
124    }
125  }
126  unless ($found) {
127    $self->reset;
128    return ();
129  }
130  return ($key,$value) if $short_keys;
131
132  my @keylist = map {($_->{'keys'}->[$_->{'hashindex'}])
133		       . "[" . ($_->{'arrayindex'}-1) ."]"; } @{$stack};
134  return (join(".",@keylist),$value);
135}
136
137sub reset {
138    my $self = shift;
139    $self->{'arrayindex'} = 0;
140    $self->{'hashindex'} = 0;
141    $self->{'keys'}=[$self->{'stone'}->tags];
142    $self->{'stack'}=[$self];
143}
144
145sub DESTROY {
146    my $self = shift;
147    if (ref $self->{'stone'}) {
148	$self->{'stone'}->_register_cursor($self,undef);
149    }
150}
151
152# Next will return the next index in its Stone object,
153# indexing first through the members of the array, and then through
154# the individual keys.  When iteration is finished, it resets itself
155# and returns an empty array.
156sub next {
157    my $self = shift;
158    my($arrayi,$hashi,$stone,$keys) = ($self->{'arrayindex'},
159				       $self->{'hashindex'},
160				       $self->{'stone'},
161				       $self->{'keys'});
162    unless ($stone->exists($keys->[$hashi],$arrayi)) {
163	$self->{hashindex}=++$hashi;
164	$self->{arrayindex}=$arrayi=0;
165	unless (defined($keys->[$hashi]) &&
166		defined($stone->get($keys->[$hashi],$arrayi))) {
167	    $self->reset;
168	    return ();
169	}
170    }
171    $self->{arrayindex}++;
172    return ($keys->[$hashi],$stone->get($keys->[$hashi],$arrayi));
173}
174
175
1761;
177