package DBIx::Class::Wrapper::Factory;
{
  $DBIx::Class::Wrapper::Factory::VERSION = '0.002';
}

use Moose;
extends qw/DBIx::Class::Wrapper::FactoryBase/;

=head1 NAME

DBIx::Class::Wrapper::Factory - A factory class that decorates a L<DBIx::Class::ResultSet>.

=head1 SYNOPSIS

A model implementing the role DBIx::Class::Wrapper will automatically instanciate
subclasses of this for any underlying DBIx::Class ResultSet.

To implement your own factory containing your business code for the underlying
DBIC resulsets, you need to subclass this.

=head1 PROPERTIES

=head2 dbic_rs

 The original L<DBIx::Class::ResultSet>. Mandatory.

=head2 bm

The business model consuming the role L<DBIx::Class::Wrapper>. Mandatory.

=cut

has 'dbic_rs' => ( is => 'ro' , isa => 'DBIx::Class::ResultSet', required => 1 , lazy_build => 1);
has 'bm' => ( is => 'ro' , does => 'DBIx::Class::Wrapper' , required => 1 , weak_ref => 1 );
has 'name' => ( is => 'ro' , isa => 'Str' , required => 1 );

sub _build_dbic_rs{
    my ($self) = @_;
    return $self->build_dbic_rs();
}

=head2 build_dbic_rs

Builds the dbic ResultSet to be wrapped by this factory.
You can override this in your business specific factories to build
specific resultsets.

=cut

sub build_dbic_rs{
  my ($self) = @_;
  my $resultset = eval{ return $self->bm->dbic_schema->resultset($self->name); };
  if( my $err = $@ ){
    confess("Cannot build resultset for $self NAME=".$self->name().' :'.$err);
  }
  return $resultset;
}


=head2 create

Creates a new object in the DBIC Schema and return it wrapped
using the wrapper method.

=cut

sub create{
    my ($self , $args) = @_;
    return $self->wrap($self->dbic_rs->create($args));
}

=head2 find

Finds an object in the DBIC schema and returns it wrapped
using the wrapper method.

=cut

sub find{
    my ($self , @rest) = @_;
    my $original = $self->dbic_rs->find(@rest);
    return $original ? $self->wrap($original) : undef;
}

=head2 first

Equivalent to DBIC Resultset 'first' method.

=cut

sub first{
  my ($self) = @_;
  my $original = $self->dbic_rs->first();
  return $original ? $self->wrap($original) : undef;
}

=head2 find_or_create

Wraps around the original DBIC find_or_create method.

=cut

sub find_or_create{
  my ($self , $args) = @_;
  my $original = $self->dbic_rs->find_or_create($args);
  return $original ? $self->wrap($original) : undef;
}


=head2 pager

Shortcut to underlying dbic_rs pager.

=cut

sub pager{
  my ($self) = @_;
  return $self->dbic_rs->pager();
}

=head2 delete

Shortcut to L<DBIx::Class::ResultSet> delete method of the
underlying dbic_rs


=cut

sub delete{
  my ($self , @rest) = @_;
  return $self->dbic_rs->delete(@rest);
}

=head2 get_column

Shortcut to the get_column of the decorated dbic_rs

=cut

sub get_column{
  my ($self, @rest) = @_;
  return $self->dbic_rs->get_column(@rest);
}

=head2 search_rs

Alias for search

=cut

sub search_rs{
  goto &search;
}

=head2 search

Search objects in the DBIC Schema and returns a new intance
of this factory.

=cut

sub search{
    my ($self , @rest) = @_;
    my $class = ref($self);
    return $class->new({ dbic_rs => $self->dbic_rs->search_rs(@rest),
			 bm => $self->bm(),
			 name => $self->name()
		       });
}


=head2 wrap

Wraps an L<DBIx::Class::Row> in a business object. By default, it returns the
Row itself.

Override that in your subclasses of factories if you need to wrap some business code
around the L<DBIx::Class::Row>

=cut

sub wrap{
    my ($self , $o) = @_;
    return $o;
}


=head2 all

Similar to DBIC Resultset all.

Usage:

 my @objs = $this->all();

=cut

sub all{
  my ($self) = @_;
  my $search = $self->search();
  my @res = ();
  while( my $next = $search->next() ){
    push @res , $next;
  }
  return @res;
}

=head2 loop_through

Loop through all the elements of this factory
whilst paging and execute the given code
with the current retrieved object.

WARNINGS:

Make sure your resultset is ordered as
it wouldn't make much sense to page through an unordered resultset.

In case other things are concurrently adding to this resultset, it is possible
that the code you give will be called with the same objects twice.

If it's not the problem and if the rate at which objects are added is
not too fast compared to the processing you are doing in the code, it
should be just fine.

In other cases, you probably want to wrap this in a transaction to have
a frozen view of the resultset.

Usage:

 $this->loop_through(sub{ my $o = shift ; do something with o });
 $this->loop_through(sub{...} , { limit => 1000 }); # Do only 1000 calls to sub.
 $this->loop_through(sub{...} , { rows => 20 }); # Go by pages of 20 rows

=cut

sub loop_through{
  my ($self, $code , $opts ) = @_;

  unless( defined $opts ){
      $opts = {};
  }

  my $limit = $opts->{limit};
  my $rows = defined $opts->{rows} ? $opts->{rows} : 10;

  # init
  my $page = 1;
  my $search = $self->search(undef , { page => $page , rows => $rows });
  my $last_page = $search->pager->last_page();

  my $ncalls = 0;
  # loop though all pages.
 PAGELOOP:
  while( $page <= $last_page ){
    # Loop through this page
    while( my $o = $search->next() ){
      $code->($o);
      $ncalls++;
      if( $limit && ( $ncalls >= $limit ) ){
        last PAGELOOP;
      }
    }
    # Done with this page.
    # Go to the next one.
    $page++;
    $search = $self->search(undef, { page => $page , rows => $rows });
  }
}

=head2 next

Returns next Business Object from this current DBIx::Resultset.

=cut

sub next{
    my ($self) = @_;
    my $next_o = $self->dbic_rs->next();
    return undef unless $next_o;
    return $self->wrap($next_o);
}

=head2 count

Returns the number of objects in this ResultSet.

=cut

sub count{
    my ($self) = @_;
    return $self->dbic_rs->count();
}


__PACKAGE__->meta->make_immutable();
1;