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_clas
+s));

=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 de
+fault
                    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->skeleto
+n ?

  $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>) orde
+r.

=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_s
+ql } @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->tab
+le,$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_ar
+rayref({}), $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 => { -i
+n => [@_] }});
  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 },{ $sel
+f->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>
[download]

And the columns live in Table::Denormalized::Column

package Table::Denormalized::Column;
use strict;

=head1 NAME

Table::Denormalized::Column - Encapsulate information for a SQL column

=head1 SYNOPSIS

=head1 ABSTRACT

This module trivially encapsulates the information about a column
in an SQL database as the pair of name and type.

=cut

use base 'Class::Accessor';

__PACKAGE__->mk_accessors(qw(name type));

=head2 C<< $column->as_sql >>

Returns an SQL fragment suitable to be used in an
C<ALTER TABLE ADD COLUMN %s> statement.

=cut

sub as_sql {
  my $self = shift;
  return sprintf "%s %s", $self->name, $self->type
};

1;

=head1 AUTHOR

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

=head1 SEE ALSO

L<DBI>, L<Class::DBI>
[download]

The columns get collected in column sets:

package Table::Denormalized::ColumnSet;
use strict;

=head1 NAME

Table::Denormalized::ColumnSet - Encapsulate a group of columns

=head1 SYNOPSIS

  use Table::Denormalized::ColumnSet;

  my $file_info = Table::Denormalized::ColumnSet->new(
    _name    => 'File Information',
    uri      => 'VARCHAR(1024)',
    size     => 'INTEGER',
    modified => 'INTEGER',
    md5      => 'VARCHAR(64)',
  );

=head1 ABSTRACT

This module (trivially) encapsulates a set of columns
and gives that set a name.

=cut

use base 'Class::Accessor';

__PACKAGE__->mk_accessors(qw(name columns));

sub new {
  my ($class,%args) = @_;
  my $name = delete $args{_name};
  my $self = $class->SUPER::new({name => $name, columns => []});

  if (! $self->name) {
    my $caller = (caller(0))[0];
    $caller =~ s!.*::Plugin::!!;
    $self->name($caller)
  };
  $self->add_column(%args);
  $self;
};

sub add_column {
  my $self = shift;
  while (@_) {
    if (ref $_[0]) {
      push @{ $self->columns }, shift;
    } else {
      my ($name,$type) = splice @_,0,2;
      push @{ $self->columns }, Table::Denormalized::Column->new({ nam
+e => $name, type => $type });
    };
  };
};

1;

=head1 AUTHOR

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

=head1 SEE ALSO

L<DBI>, L<Class::DBI>
[download]

The rows live in the ::Row class, from which you could inherit your own row class:

package Table::Denormalized::Row;
use strict;
use base 'Class::Accessor';

=head1 NAME

Table::Denormalized::Row - Row-based DB interaction

=head1 SYNOPSIS

  package My::Row;
  use base 'Table::Denormalized::Row';

  my $results = $idx->query({ artist => 'Jamiroquai' });
  $_->delete
    for @$results;

=head1 ABSTRACT

This module provides four (trivial) methods
for every row, in a Class::DBI-style manner.

It requires some magic entries in the hash (until these
get moved into inside-out objects) :

  _id    - the primary key of the table
  _table - a reference to the corresponding Table::Denormalized object

=head2 C<< $row->delete >>

Removes the row from the database

=cut

sub delete {
  my ($self) = @_;
  $self->{_table}->delete($self->{_id});
};

=head2 C<< $row->update >>

Writes the body of the row into the database

=cut

sub update {
  my ($self) = @_;
  $self->{_table}->update($self);
};

=head2 C<< $row->_skeleton >>

Returns the skeleton of the row, that is, all keys
that match C</^_/>. This is convenient when copying
or cloning a row.

=cut

sub _skeleton {
  my ($self) = @_;
  map { /^_/ ? ($_ => $self->{$_}) : () } keys %$self
};

=head2 C<< $row->_body >>

Returns the body of the row, that is, all keys
that do not match C</^_/>. This is convenient when copying
or cloning a row.

=cut

sub _body {
  my ($self) = @_;
  map { ! /^_/ ? ($_ => $self->{$_}) : () } keys %$self
};

1;

=head1 AUTHOR

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

=head1 SEE ALSO

L<DBI>, L<Class::DBI>
[download]