package Table::Denormalized;
use strict;

=head1 NAME

Table::Denormalized - Dynamically add columns to a table

=head1 SYNOPSIS

  use Table::Denormalized;
  my $table = Table::Denormalized->new(
    table     => 'my_table',
    primary   => '_id',
    row_class => 'My::Special::Row',
  );

  $table->create;

  # somewhere else, later:

  $table->add_set(@columnsets);
  $table->alter_table;

  # The table now has all columns as specified in the column sets

=cut

use base 'Class::Accessor';
use SQL::Abstract::Clauses;
use Carp qw(croak);
use Data::Dumper;
use Scalar::Util 'weaken';

use Table::Denormalized::Column;
use Table::Denormalized::ColumnSet;
use Table::Denormalized::Row;
use Table::Denormalized::ResultSet;

use vars qw($VERSION);

$VERSION = '0.01';

__PACKAGE__->mk_accessors(qw(columnsets dbh sql table primary row_class));

=head1 ABSTRACT

This module provides the scaffolding to dynamically
add (and in the future also remove) columns from a
database table.

=head2 C<< new >>

Constructs a new instance.

  dsn               DBI connect string
  dbh               A valid dbh - may be given instead of the DSN
  columnsets 		The column sets, can also be added via add_set
  table             The name of the table, default is 'file_cache'
  primary           The name of the primary key, default is '_id'
  row_class         The class single rows will be blessed into. The default
                    is "$class::Row", which should inherit from
                    Table::Denormalized::Row

=cut

sub new {
  my ($class,%args) = @_;
  if (exists $args{dbh}) {
    # all is well
  } elsif (exists $args{dsn}) {
    $args{dbh} = DBI->connect(delete $args{dsn})
  };

  $args{sql} ||= SQL::Abstract::Clauses->new();

  my $self = $class->SUPER::new({
    columnsets => [],
    table     => 'file_cache',
    primary   => '_id',
    row_class => (__PACKAGE__ . "::Row"),
    %args
  });

  # Warn somehow if $self->primary is not in $self->row_class->skeleton ?

  $self
};

=head2 C<< create >>

Issues the C<CREATE TABLE> command.

=cut

sub create {
  my ($self) = @_;
  my $dbh = $self->dbh;
  {
    local $dbh->{PrintError};
    local $dbh->{RaiseError};
    $dbh->do(sprintf 'drop table %s', $self->table);
  }
  $dbh->do(sprintf 'create table %s (%s INTEGER PRIMARY KEY)', $self->table, $self->primary);
};

=head2 C<< columns >>

Enumerates the columns and returns them in alphabetical (C<sort>) order.

=cut

sub columns {
  my $self = shift;
  my %columns;
  for my $set (@{ $self->columnsets }) {
    for my $col (@{ $set->columns }) {
      $columns{$col->name} = $col;
    };
  };
  map {$columns{$_}} sort keys %columns
};

=head2 C<< add_set SETS >>

Adds one or more new column sets to the table, but does not
yet alter the table.

=cut

sub add_set {
  my $self = shift;
  push @{ $self->columnsets }, @_;
  $self;
};

=head2 C<< missing_columns >>

Returns the columns that are in the column sets but are
not yet in the table structure of the database.

=cut

sub missing_columns {
  my $self = shift;
  my (@columns) = $self->columns;
  my @existing;
  my $sth = $self->dbh->prepare(sprintf 'select * from %s where 1 = 0', $self->table);
  $sth->execute();

  my (@missing) = grep {! exists $sth->{NAME_lc_hash}->{ lc $_->name }} ($self->columns);
  $sth->finish;

  return @missing;
};

=head2 C<< alter_sql >>

Returns the SQL commands that need to be executed to
alter the table structure to what the column sets specify.

Currently will only generate C<ADD COLUMN> statements and never
C<DROP COLUMN> statements. This seems to be sensible because
different programs might want to use the same table.

=cut

sub alter_sql {
  my $self = shift;
  my @missing_columns = $self->missing_columns;
  return
    unless @missing_columns;

  map { sprintf "alter table %s add column %s", $self->table, $_->as_sql } @missing_columns;
};

=head2 C<< alter_table >>

Actually executes the statements returned by C<alter_sql>
and thus brings the table in synch with the specification.

=cut

sub alter_table {
  my $self = shift;
  for my $col ($self->alter_sql) {
    $self->dbh->do($col)
      or warn $col;
  };

  1;
};

sub update_or_insert {
  my ($self,$data) = @_;

  my $id = $self->primary;

  #croak "Didn't find column $id in " . Dumper($data)
  #  unless exists $data->{$id};

  my $rows;
  if (defined $id) {
    my %values = ref $data eq 'HASH' ? %$data : $data->body;
    my ($sql,@bind) = $self->sql->update($self->table, \%values, { $id => $data->{$id}});

    my $sth = $self->dbh->prepare_cached($sql);
    $rows = $sth->execute(@bind);
  };

  unless ($rows > 0) {
    # Need an insert:
    my ($sql,@bind) = $self->sql->insert($self->table, $data);
    my $sth = $self->dbh->prepare_cached($sql);
    my $rows = $sth->execute(@bind);

    die $sth->error_string
      unless $rows > 0;

    if (! exists $data->{$id}) {
      # Need to fetch the (fresh) id from the database
      # Ah, the joy of restricting myself to SQLite
      $data->{$id} = $self->dbh->last_insert_id(undef,undef,$self->table,$self->primary);

      # This should be rolled up into a transaction that does (INSERT; SELECT last_insert_id)
    };
  };

  my $blessed = $self->rows_to_objects([$data]);
  return $blessed->[0]
};

=head2 C<< rows_to_objects ROWREF>>

Blesses all rows in the array reference given by ROWREF
into the desired class and adds a weak backlink to
the table to each row.

=cut

sub rows_to_objects {
  my ($self,$rows) = @_;
  my $class = $self->row_class;
  my $weak = $self;

  for (@$rows) {
    bless $_, $class;
    $_->{_table} = $weak;
  };
  $rows
};

=head2 C<< query WHERE >>

Returns the blessed results of an SQL::Abstract C<select WHERE>
expression. The results will be stored in an array reference
which is blessed into a Table::Denormalized::Resultset.

=cut


# Split up in execute/fetch
sub query {
  my ($self,$query) = @_;
  # $query = defined $query ? $query : {};
  # warn Dumper $query;
  $query ||= {};
  my $table = $self->table;
  my @columns = map {$_->name} $self->columns;
  my ($sql,@bind) = $self->sql->select($table,['_id',@columns],where => $query, order_by => [$self->primary]);

  my $sth = $self->dbh->prepare_cached($sql);
  $sth->execute(@bind);
  my $results = Table::Denormalized::ResultSet->new( $sth->fetchall_arrayref({}), $query );

  $self->rows_to_objects($results);

  $results
};

=head2 C<< all >>

Returns all rows stored in the table.

=cut

sub all { shift->query({}) };

=head2 C<< delete ITEMS >>

Deletes all rows as given by their primary key values.

=cut

# Split up in execute/fetch
sub delete {
  my ($self) = shift;
  my $table = $self->table;
  my ($sql,@bind) = $self->sql->delete($table,{ $self->primary => { -in => [@_] }});
  my $sth = $self->dbh->prepare_cached($sql);
  $sth->execute(@bind);

  # Wipe the cache, if any
};

=head2 C<< update ITEMS >>

Saves the data from the hashrefs given by ITEMS into
the table.

=cut

# Split up in execute/fetch
sub update {
  my ($self) = shift;
  my $table = $self->table;
  for my $row (@_) {
    my ($sql,@bind) = $self->sql->update($table,{ $row->_body },{ $self->primary => $row->{$self->primary} });
    my $sth = $self->dbh->prepare_cached($sql);
    $sth->execute(@bind);
  };

  # Wipe/reload/update the cache, if any
};


1;

=head1 AUTHOR

Max Maischein, E<lt>corion@cpan.orgE<gt>

=head1 SEE ALSO

L<DBI>, L<Class::DBI>