package DBIx::Iterator;

use strict;
use warnings;

use base 'Exporter';

our @EXPORT_OK = qw(mk_iterator list_iterator sql_iterator);

sub sql_iterator {
  my %cfg = @_;
  my (   $sql, $args, $select, $binds, $transform, $dbh, $master, $outer, $cache) =
  @cfg{qw(SQL   ARGS   SELECT   BIND    TRANSFORM   DBH   MASTER   OUTER   CACHE)};

  $args ||= [];
  my @arg = ( undef, @$args );

  my @bind;
  if ( defined $binds ) {
    @bind = ref($binds) ? ( undef, @$binds ) : ( $binds ) x @arg;
  }

  my $key;
  my $master_cnt;
  my $nxt_master;
  my $rows = [];
  sub {
    until (@$rows) {
      if ( $master ) {
        $nxt_master = $master->() or return;
      } else {
        return if $master_cnt++;
        $nxt_master = {};
      }
      my $sth = $dbh->prepare($sql);
      my $cache_hit;
      if ( $cache ) {
        no warnings 'uninitialized';
        $key = join $;, @$nxt_master{@$args};
        if ( exists( $cache->{$key} ) ) {
          $rows = [ @{$cache->{$key}} ];
          $cache_hit = 1;
        }
      }
      unless ( $cache_hit ) {
        if ( defined $binds ) {
          $sth->bind_param($_, $nxt_master->{$arg[$_]}, $bind[$_]) for 1..$#arg;
        } else {
          $sth->bind_param($_, $nxt_master->{$arg[$_]}) for 1..$#arg;
        }
        $sth->execute();
        $rows = $sth->fetchall_arrayref();
        $rows = $transform->($rows,$nxt_master,\%cfg) if $transform;
        $cache->{$key} = [ @$rows ] if $cache;
      }
      $rows = [ [] ] if $outer and !@$rows;
    }

    my $nxt_row = shift @$rows;
    @$nxt_master{@$select} = @$nxt_row;
    return $nxt_master;
  }
}

sub mk_iterator {
  my %cfg;
  if ( @_ and UNIVERSAL::isa($_[0], 'HASH') ) {
    %cfg = %{shift(@_)};
  }
  my $f;
  while ( my $nxt_f = shift(@_) ) {
    if ( UNIVERSAL::isa($nxt_f, 'ARRAY' ) ) {
      my @join = $nxt_f;
      push @join, shift(@_) while @_ and UNIVERSAL::isa($_[0], 'ARRAY' );
      my $new_cfg = { %cfg };
      $new_cfg->{MASTER} = $f;
      $f = join_iterators($new_cfg, @join);
    } else {
      my %override = ( @_ and UNIVERSAL::isa($_[0], 'HASH')) ? %{shift(@_)} : ();
      my %new_cfg = %cfg;
      $new_cfg{MASTER} = $f if $f;
      $f = $nxt_f->(%new_cfg, %override);
    }
  }
  return $f;
}

sub join_iterators {
  my %cfg;
  if ( @_ and UNIVERSAL::isa($_[0], 'HASH') ) {
    %cfg = %{shift(@_)};
  }
  my ($master, $dbh) = @cfg{qw(MASTER DBH)};
  my @mk_iter = @_;
  my $nxt_master;
  my $master_cnt;
  my @master_list;

  # Transform master iterator into one which returns
  # a 'more' indicator, followed by the value and an
  # end flag for each iterator in the list.
  my $new_master = sub {
    unless ( @master_list ) {
      if ( $master ) {
        my $nxt = $master->() or return;
        @master_list = ( $nxt, ($nxt, undef ) x @mk_iter );
      } else {
        return if $master_cnt++;
        @master_list = ( {}, ( {}, undef ) x @mk_iter );
      }
    }
    my $nxt_master = shift @master_list;
    return unless $nxt_master;
    return { %$nxt_master };
  };
  my $new_cfg = { %cfg, MASTER => $new_master };
  my @iter = map {
    mk_iterator( $new_cfg, @$_ )
  } @mk_iter;
  my $idx = @mk_iter;

  # Exhaust every iterator before seeing if master
  # iterator has more values.
  sub {
    {
      if ( $idx >= @mk_iter ) {
        my $tmp = $new_master->() or return;
        $idx = 0;
      }
      my $nxt = $iter[$idx]->();
      return $nxt if $nxt;
      $idx++;
      redo;
    }
  }
}

sub list_iterator {
  my %cfg = @_;
  my (   $list,$select, $transform, $master, $outer) =
  @cfg{qw(LIST SELECT   TRANSFORM   MASTER   OUTER)};

  my $master_cnt;
  my $nxt_master;
  my $rows = [];
  sub {
    until (@$rows) {
      if ( $master ) {
        $nxt_master = $master->() or return;
      } else {
        return if $master_cnt++;
        $nxt_master = {};
      }
      $rows = [ @$list ];
      $rows = $transform->($rows,$nxt_master,\%cfg) if $transform;
      $rows = [ [] ] if $outer and !@$rows;
    }

    my $nxt_row = shift @$rows;
    @$nxt_master{@$select} = @$nxt_row;
    return $nxt_master;
  }
}
1;

__END__

=head1 NAME

DBIx::Iterator - An iterator package for SQL statements

=head1 SYNOPSIS

    use DBIx::Iterator qw(list_iterator sql_iterator mk_iterator);

    sub iter_generator1 {
      sql_iterator(
        SQL => $sql_statement,
        %other_options,
        @_,
      )
    };

    sub list_iter_generator {
      list_iterator(
        LIST => [ @list_of_lists ],
        \%more_options,
      )
    }

    my $iterator = mk_iterator(
      \%main_options,
      \&iter_generator1, \%more_options,
      \&iter_generator2,
      \&iter_generator3,
      etc.
    );

    or:

    my $iterator = mk_iterator(
      \%main_options,
      \&iter_generator1, \%iter_generator1_arguments,
      [
        \&iter_generator2,
        \&iter_generator3,
        etc.
      ],
      [
        \&iter_generator4,
        \&iter_generator5,
        etc.
      ],
      etc.
    );

    while ( my $row = $iterator->() ) {
      # $row is a hashref
    }

=head1 DESCRIPTION

This package allows you to have a nested SQL iterator without having to
build nested for loops. Nothing is exported by default, but functions
sql_iterator and mk_iterator are exported if explicitly requested.

=over 4

=item mk_iterator

Returns an iterator function which will return a hash reference on every
call.

The first argument is a hash reference, usually containing the database handle, and all following arguments are
individual iterator generators that optionally accept a configuration hash. Each iterator generated
is passed to the next generator in the 'MASTER' slot in the configuration hash, and the database
handle is passed to every iterator in the 'DBH' slot.

The argument following each generator may be a hash reference, which will be passed to
the generator which can be used, e.g., to override the generator's default configuration.

=item sql_iterator

Returns an iterator. Usually used inside an iterator generator function.

Accepts a hash, whose keys may be:

SQL - The sql statement.

ARGS - Array ref of hash keys corresponding to '?' placeholder arguments in the sql.

BIND - Array ref of DBI data types used to bind the ARGS to the sql statement. Or a
scalar containing a single type to bind to all arguments.

SELECT - Keys to add to the hashref returned from the iterator. Usually corresponds
to the select clause in the sql statement, but names may be different.

TRANSFORM - A subroutine that takes all rows returned by the sql in an arrayref,
and returns a new array ref of rows transformed. May be used to 'flatten' the
results of a sql statement.

OUTER - Like an outer join. If no rows are returned by the sql statement,
return the master row once before fetching a new master row.

DBH - The database handle. Usually not required, as it is passed in by default
via mk_iterator().

MASTER - The parent iterator. Usually not required, as it is passed in by default
via mk_iterator().

CACHE - A hashref used to cache the selected data (key is the data corresponding to
the ARGS option joined by $SUBSEP). 

=back

=head1 EXAMPLES

  sub get_customers {
    mk_sql_iterator(
      SQL => 'select cust_id, cust_name from customers',
      SELECT => [qw(CUST_ID CUSTOMER_NAME)],
      @_,
    );
  }

  sub get_orders {
    mk_sql_iterator(
      SQL => 'select order_no, order_amt from orders where cust_id = ?'
      SELECT => [qw(ORDER_NO TOTAL_AMT)],
      ARGS => ['CUST_ID'],
      @_,
    );
  }

  my $f = mk_iterator(
    { DBH => $dbh },
    \&get_customers,
    \&get_orders,
  );

  while (my $order = $f->()) {
    # $order is hash ref with keys CUST_ID, CUSTOMER_NAME,
    # ORDER_NO, and TOTAL_AMT
  }

=head1 AUTHOR
runrig

=head1 COPYRIGHT

 This module is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<Iterator>.

=cut
=cut