DustyDB::Collection - collections of records

  package WhatsIt;
  use DustyDB::Object;

  has key bobble => ( is => 'rw', isa => 'Str' );
  has bits   => ( is => 'rw', isa => 'Str', predicate => 'has_bits' );

  package main;
  use DustyDB;

  my $db = DustyDB->new( path => 'foo.db' );
  my $model = DustyDB->model('WhatsIt');

  # All whatsits with a bobble containing fluff
  my $iter = $model->all( bobble => qr/fluff/ ); 
  while (my $whatsit = $iter->next) {
      print "Your fluff has bits of ", $whatsit->bits, " in it.\n";
  }

  # Iterate through those that actually have bits
  $iter->filter( 'has_bits' );
  for my $whatsit ($iter->records) {
      print "Whatsit ", $whatsit->bobble, " has bits.\n";
  }

  # and so on...

  $collection->filter( %params );
  $collection->filter( $method_name );
  $collection->filter( $code_ref );

  my $count = $collection->count;

  my $record = $collection->first;

  my $record = $collection->last;

  my $record = $collection->next;

  $collection->reset;

  my @records = $collection->contextual;
  my $iter    = $collection->contextual;

package DustyDB::Collection;
our $VERSION = '0.06';

use Moose;

use Carp ();

use Scalar::Util qw( reftype );

has model => (
    is => 'rw',
    isa => 'DustyDB::Model',
    required => 1,
    handles => [ qw( db record_meta ) ],
);

has filter_subroutine => (
    is => 'rw',
    isa => 'CodeRef',
    predicate => 'has_filter_subroutine',
);

has records => (
    is => 'rw',
    isa => 'ArrayRef',
    lazy => 1,
    auto_deref => 1,
    default => \&_build_records,
);

has iterator_index => (
    is => 'rw',
    isa => 'Int',
    default => 0,
);

# FIXME This implementation goes ahead and grabs all the data up front.  This
# could be a VeryBadThing(tm). That is, if we have a bazillion records and we
# dump every one of them into this array: bad stuff. This is especially bad
# since we pre-construct each of these too. Very Bad.
#
# However, it's easy, which is, in my book, a good thing for 0.01 versions.

sub _build_records {
    my $self = shift;

    my @originals = $self->record_meta->list_all_objects( db => $self->db );

    # If we have a filter
    if ($self->has_filter_subroutine) {
        my @records;
        local $_;

        for (@originals) {
            if ($self->filter_subroutine->()) {
                push @records, $_;
            }
        }

        return \@records;
    }

    # Without a filter
    else {
        return \@originals;
    }
}

sub filter {
    my $self = shift;

    # Handle the single argument call varieties
    if (@_ == 1) {

        # Did we get a subroutine?
        if (ref $_[0] and reftype $_[0] eq 'CODE') {
            my $sub = $_[0];

            # We need to wrap it to construct a real object for the sub
            $self->filter_subroutine( sub {
                return $sub->();
            } );
        }

        # Is it a hash reference?
        elsif (ref $_[0] and reftype $_[0] eq 'HASH') {
            $self->filter_subroutine( $self->_hash_to_filter( %{ $_[0] } ) );
        }

        # Did we get a method name?
        elsif ($self->record_meta->has_method($_[0])) {
            my $method = $_[0];

            $self->filter_subroutine( sub {
                return $_->$method();
            } );
        }

        # I don't know what this is
        else {
            Carp::croak "not sure what to do with that kind of filter";
        }
    }

    # Assume it's a hash
    else {
        $self->filter_subroutine( $self->_hash_to_filter( @_ ) );
    }

    $self->records( $self->_build_records );

    return $self->contextual;
}

sub _hash_to_filter {
    my $self   = shift;
    my %params = @_;
    my $attrs  = $self->record_meta->get_attribute_map;

    # First, a sanity check 
    for my $name (keys %params) {

        # Don't filter if we can't filter
        Carp::croak "$name is not an attribute of ", $self->class_name
            unless defined $attrs->{ $name };
    }

    # Second, build the checker routine 
    return sub {
        my $result = 1;
        while (my ($name, $match) = each %params) {

            # TODO It would be lovely to have the smart match operator here, but
            # I want this to work on 5.8 still. Perhaps have this for 5.8, but
            # switch on ~~ if the compiler is 5.10?

            # Handle a regex
            if (ref $match and ref $match eq 'Regexp') {
                $result &&= $_->{$name} =~ /$match/;
            }

            # Handle a number
            elsif ($attrs->{ $name }->type_constraint->is_a_type_of('Num')) {
                $result &&= $_->{$name} == $match;
            }

            # Handle any other scalar
            else {
                $result &&= $_->{$name} eq $match;
            }
        }

        return $result;
    };
}

sub count {
    my $self = shift;
    my @records = $self->records;
    return scalar @records;
}

sub first {
    my $self = shift;
    return $self->count > 0 ? $self->records->[0] : undef;
}

sub last {
    my $self = shift;
    return $self->count > 0 ? $self->records->[-1] : undef;
}

sub next {
    my $self = shift;

    # Get the index
    my $index = $self->iterator_index;
    $self->iterator_index( $index + 1);

    # Get the object
    my $next;
    if (defined $self->records->[ $index ]) {
        $next = $self->records->[ $index ];
    }

    # On undef we need to reset the iterator
    else {
        $self->reset;
    }

    return $next;
}

sub reset {
    my $self = shift;
    $self->iterator_index(0);
}

sub contextual {
    my $self = shift;
    return wantarray ? $self->records : $self;
}

1;