use strict;
use warnings;
package Mixin::ExtraFields::Driver::DBIC;
our $VERSION = '0.003';

use base 'Mixin::ExtraFields::Driver';
# ABSTRACT: store Mixin::ExtraFields data in a DBIx::Class store

use Carp ();


sub from_args {
  my ($class, $arg) = @_;

  # schema will be either a DBIx::Class::Schema or a methodref which, called on
  # an object, returns a schema
  my $schema     = $arg->{schema} || sub { $_[1]->result_source->schema };
  my $rs_moniker = $arg->{rs_moniker}
    or Carp::croak "no rs_moniker provided to $class";

  my $self = {
    schema => $schema,
    rs_moniker   => $rs_moniker,
    id_column    => $arg->{id_column}    || 'object_id',
    name_column  => $arg->{name_column}  || 'extra_name',
    value_column => $arg->{value_column} || 'extra_value',
  };

  bless $self => $class;
}

sub id_column       { $_[0]->{id_column}    }
sub name_column     { $_[0]->{name_column}  }
sub value_column    { $_[0]->{value_column} }

sub _rs {
  my ($self, $object) = @_;

  if (eval { $self->{schema}->isa('DBIx::Class::Schema') }) {
    return $self->{schema}->resultset( $self->{rs_moniker} );
  } else {
    my $method = $self->{schema};
    return $self->$method($object)->resultset($self->{rs_moniker});
  }
}

sub exists_extra {
  my ($self, $object, $id, $name) = @_;

  my $count = $self->_rs($object)->count({
    $self->id_column   => $id,
    $self->name_column => $name,
  });

  return ! ! $count;
}

sub get_extra {
  my ($self, $object, $id, $name) = @_;

  my $row = $self->_rs($object)->find({
    $self->id_column   => $id,
    $self->name_column => $name,
  });

  return undef unless $row;

  my $value_column = $self->value_column;
  return $row->$value_column;
}

sub get_all_extra {
 
  Carp::confess 'get_all_extra is fatal outside of list context'
    unless wantarray;

 my ($self, $object, $id, $name) = @_;

  my @rows = $self->_rs($object)->search({
    $self->id_column => $id,
  });

  return unless @rows;

  my $name_column  = $self->name_column;
  my $value_column = $self->value_column;
  my @all = map { $_->$name_column, $_->$value_column } @rows;

  return @all;
}

sub get_all_extra_names {
  my ($self, $object, $id) = @_;

  Carp::confess 'get_all_extra_names is fatal outside of list context'
    unless wantarray;

  my %extra = $self->get_all_extra($object, $id);
  return keys %extra;
}

sub get_all_detailed_extra {
  my ($self, $object, $id) = @_;

  Carp::confess 'get_all_detailed_extra is fatal outside of list context'
    unless wantarray;

  my @rows = $self->_rs($object)->search({
    $self->id_column => $id,
  });

  my $name_column  = $self->name_column;
  my $value_column = $self->value_column;

  my %return;
  for my $row (@rows) {
    $return{ $row->name_column } = { value => $row->$value_column };
  }

  return %return;
}

sub set_extra {
  my ($self, $object, $id, $name, $value) = @_;

  my $id_column    = $self->id_column;
  my $name_column  = $self->name_column;
  my $value_column = $self->value_column;

  my $obj = $self->_rs($object)->update_or_create({
    $self->id_column    => $id,
    $self->name_column  => $name,
    $self->value_column => $value,
  });
}

sub delete_extra {
  my ($self, $object, $id, $name) = @_;

  $self->_rs($object)->search({
    $self->id_column   => $id,
    $self->name_column => $name,
  })->delete;
}

sub delete_all_extra {
  my ($self, $object, $id, $name) = @_;

  $self->_rs($object)->search({
    $self->id_column => $id,
  })->delete;
}

sub _setup_class {
  my ($self, $value, $arg) = @_;
  $value ||= {};

  Carp::croak("no table name supplied") unless $value->{table};

  $value->{pk_column}    ||= 'id';
  $value->{id_column}    ||= 'object_id';
  $value->{name_column}  ||= 'extra_name';
  $value->{value_column} ||= 'extra_value';

  my $target = $arg->{into};

  # ensure target isa DBIx::Class

  $target->load_components(qw(Core));

  $target->table($value->{table});

  $target->add_columns(
    $value->{pk_column} => {
      data_type   => 'int',
      is_nullable => 0,
      is_auto_increment => 1,
    },

    $value->{id_column} => {
      data_type   => 'int',
      is_nullable => 0,
    },

    $value->{name_column} => {
      data_type   => 'varchar',
      size        => 32,
      is_nullable => 0,
    },

    $value->{value_column} => {
      data_type   => 'varchar',
      size        => 64,
      is_nullable => 0,
    },
  );

  $target->set_primary_key($value->{pk_column});

  $target->add_unique_constraint(
    "$value->{id_column}_$value->{name_column}" => [
      $value->{id_column}, $value->{name_column}
    ],
  );

  return 1;
};

use Sub::Exporter -setup => {
  collectors => [ -setup => \'_setup_class' ],
};

1;

__END__

=pod

=head1 NAME

Mixin::ExtraFields::Driver::DBIC - store Mixin::ExtraFields data in a DBIx::Class store

=head1 VERSION

version 0.003

=head1 DESCRIPTION

This class provides a driver for storing Mixin::ExtraFields data in
DBIx::Class storage.  You'll need to create a table resultsource for the
storage of entires and you'll need to use Mixin::ExtraFields in the class that
gets the extras.

So, you might create:

    package My::Schema::ObjectExtra;
    use Mixin::ExtraFields::Driver::DBIC -setup => { table => 'object_extras' };
    1;

...and elsewhere;

    package My::Schema::Object;
    use base 'DBIx::Class';
    ...
    use Mixin::ExtraFields -fields => {
      driver => { class => 'DBIC', rs_moniker => 'ObjectExtra' }
    };

=head1 DRIVER ARGS

The following arguments may be provided when defining the driver when setting
up Mixin::ExtraFields:

    schema       - the schema for the DBIx::Class storage (see below)
    rs_moniker   - the moniker of the result source for extras
    id_column    - the name of the column that stores object ids
    name_column  - the name of the column that stores extra field names
    value_column - the name of the column that stores extra field values

C<schema> may be an actual DBIx::Class::Schema object or a coderef which, when
called on an object, returns a schema.  The default value assumes that objects
will be DBIx::Class::Row objects, and returns their schema.

=head1 SETUP ARGS

When using Mixin::ExtraFields::Driver::DBIC to set up a table result source,
the following values may be in the argument to C<-setup> in the import call:

    table        - (required) the name of the table in the storage
    id_column    - the name of the column that stores object ids
    name_column  - the name of the column that stores extra field names
    value_column - the name of the column that stores extra field values

=begin Pod::Coverage

    id_column
    name_column
    value_column

=end Pod::Coverage

=head1 AUTHOR

  Ricardo SIGNES <rjbs@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2008 by Ricardo SIGNES.

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

=cut