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.


##</code><code>##

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__