Given that I have not found this sort of iterator already, the main concern I have is that, despite appearances (i.e. the seemingly functioning module presented below) the problem may be much harder than I realize. Therefore, my top question is: is what I'm trying to do feasible in Perl (without going to heroic lengths)? Or are there fundamental reasons for why anything like this would fail in Perl5?

The basic idea of my implementation is that the iterator object is also a hash, except that its internal bucket array pointer points to the bucket array of the hash that's being iterated over. The underlying C struct has its own independent iteration-oriented fields (e.g. riter and eiter) that are unaffected by those of other iterator instances on the same hash, or even by using CORE::each on this hash.

For my implementation I cannibalized sizeable chunks of hv.c and the pp_each section of pp.c. Unfortunately my understanding of the code that I hacked is less than complete. Therefore, even though my implementation passes the toughest test suite I could come up with, I still feel rather uncertain about the soundness of the C code, and I would particularly welcome your comments and criticisms of it.

I realize that this is a fair bit of code to read. I hope that some of you may be willing to take a look, or perhaps advise me on how to get knowledgeable feedback on a longish piece of code like this.

Many thanks in advance.

SYNOPSIS

  use Hash_Iterator;

  my $it = Hash_Iterator->new( \%some_hash );

  while ( defined( my $k = $it->each ) ) {
    # do something with $k
  }

  # $it->each restarts after hitting the end

  while ( my ( $k, $v ) = $it->each ) {
    # one more iteration
  }

  # alternatively, $it->start resets the iterator

  for ( $it->start; !$it->exhausted; $it->next ) {
    my $k = $it->value;
    # do something with $k
  }

  # here's another way to traverse the hash
  $it->start;
  until ( $it->exhausted ) {
    my ( $k, $v ) = $it->next;
    # do something with ( $k, $v )
  }


DESCRIPTION

The API is as follows:

new( $hashref )    The constructor, obviously.  The argument is
                   mandatory, and must be a hashref.

$it->each          Should behave exactly like CORE::each.

$it->start         Resets the iterator.  (It also returns the first
                   value.  This is as described in HOP.)

$it->value         Returns the current value, according to the
                   same rules as CORE::each (i.e. both key and
                   value are returned in list context); does not
                   advance the iterator.

$it->next          Advances the iterator.  (It also returns
                   the results of $it->value *before* advancing
                   the iterator, as described in HOP.)

$it->nextval       An alias for $it->next().

$it->exhausted     Returns true iff the iterator is exhausted.

NB: The only difference between the next() (or nextval()) and
each() methods is that the latter (but not the former) 
automatically resets the iterator after hitting the end once.
[download]

use strict;
use warnings;

package Hash_Iterator;

use Carp ();
BEGIN {
  *_croak   = \&Carp::croak;
}

my %Hashes;

*nextval = \&next;

!! 'keep require happy';

sub new {
  my $class = shift;
  _croak "Bad arguments to constructor"
    unless @_ == 1 and ref $_[ 0 ] eq 'HASH';

  my $hash = shift;
  my $self = bless +{}, $class;
  $Hashes{ $self } = $hash;
  $self->start;
  return $self;
}

sub start {
  my $self = shift;
  _start_iter( $self, $Hashes{ $self } );
  return $self->value;
}

sub next {
  my $self = shift;
  if ( wantarray ) {
    my @ret = $self->value;
    $self->_advance;
    return @ret;
  }
  else {
    my $ret = $self->value;
    $self->_advance;
    return $ret;
  }
}

sub each {
  my $self = shift;
  if ( wantarray ) {
    my @ret = $self->value;
    $self->exhausted ? $self->start : $self->_advance;
    return @ret;
  }
  else {
    my $ret = $self->value;
    $self->exhausted ? $self->start : $self->_advance;
    return $ret;
  }
}

sub DESTROY {
  my $self = shift;
  delete $Hashes{ $self };
  _DESTROY_iter( $self );
  return;
}

sub _advance {
  my $self = shift;
  _synch_and_advance( $self, $Hashes{ $self } )
    unless $self->exhausted;
  return;
}

use Inline C => <<EOC;

void _start_iter( HV *hv, HV *ohv ) {
  register XPVHV* xhv;

  if ( SvMAGICAL( ( SV * ) ohv ) )
    Perl_croak( "Not implemented for tied/magical hashes." );

  xhv = ( XPVHV* ) SvANY ( hv );
  xhv->xhv_riter = -1;
  xhv->xhv_eiter = NULL;

  _synch_and_advance( hv, ohv );

  return;
}

I32 exhausted( HV *hv ) {
  register XPVHV* xhv;
  if ( !hv ) Perl_croak( "Bad hash" );
  xhv = ( XPVHV* ) SvANY ( hv );
  return xhv->xhv_riter < 0;
}

void _synch_and_advance( HV *hv, HV *ohv ) {
  register XPVHV* xhv;
  register XPVHV* oxhv;

  if ( !hv || !ohv ) Perl_croak( "Bad hash" );
  xhv  = ( XPVHV* ) SvANY ( hv );
  oxhv = ( XPVHV* ) SvANY ( ohv );

  __synch( xhv, oxhv );
  __advance( xhv );
  return;
}

void __advance( register XPVHV* xhv ) {
  register HE *entry;

  if ( !xhv->xhv_array ) {
    xhv->xhv_riter = -1;
    xhv->xhv_eiter = NULL;
    return;
  }

  entry = xhv->xhv_eiter;

  /* At start of hash, entry is NULL.  */
  if ( entry ) {
    entry = HeNEXT( entry );
    while ( entry && HeVAL( entry ) == &PL_sv_placeholder )
      entry = HeNEXT( entry );
  }

  while ( !entry ) {
    xhv->xhv_riter++;
    if ( xhv->xhv_riter > ( I32 ) xhv->xhv_max ) {
      xhv->xhv_riter = -1;
      break;
    }
    entry = ( ( HE** ) xhv->xhv_array )[ xhv->xhv_riter ];

    while ( entry && HeVAL( entry ) == &PL_sv_placeholder )
      entry = HeNEXT( entry );
  }

  xhv->xhv_eiter = entry;
  return;
}

void value( HV *hv ) {
  Inline_Stack_Vars;
  register XPVHV* xhv;
  HE *entry;
  I32 gimme = GIMME_V;
  I32 n_items = 1;

  xhv = ( XPVHV* ) SvANY( hv );
  entry = xhv->xhv_eiter;

  if ( gimme == G_VOID || !entry && gimme == G_ARRAY )
    Inline_Stack_Void;          /* returns (nothing) */

  Inline_Stack_Reset;
  if ( entry ) {
    Inline_Stack_Push( hv_iterkeysv( entry ) );

    if(gimme == G_ARRAY) {
      Inline_Stack_Push( hv_iterval( hv, entry ) );
      ++n_items;
    }
  }
  else {
    /* scalar context, no entry */
    Inline_Stack_Push( sv_2mortal( &PL_sv_undef ) );
  }
  Inline_Stack_Done;
  Inline_Stack_Return(n_items);
}

void _DESTROY_iter( HV *hv ) {
  register XPVHV* xhv;
  if ( !hv ) return;
  xhv = ( XPVHV* ) SvANY ( hv );

  if ( xhv->xhv_name ) {
    if ( PL_stashcache )
      hv_delete( PL_stashcache, xhv->xhv_name, strlen( xhv->xhv_name )
+,
                 G_DISCARD );
    Safefree( xhv->xhv_name );
    xhv->xhv_name = 0;
  }
  xhv->xhv_max          = 7;    /* (it's a normal hash) */
  xhv->xhv_array        = 0;
  xhv->xhv_placeholders = 0;
}

void __synch( register XPVHV* xhv, register XPVHV* oxhv ) {
  xhv->xhv_max   = oxhv->xhv_max;
  xhv->xhv_fill  = oxhv->xhv_fill;
  xhv->xhv_keys  = oxhv->xhv_keys;
  xhv->xhv_array = ( HE ** ) oxhv->xhv_array;
}

EOC

__END__
[download]