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