The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Smolder::DB;
use strict;
use warnings;
use base 'Class::DBI::SQLite';
use Smolder::Conf qw(SQLDir DataDir);
use DBI;
use Class::DBI::Plugin::RetrieveAll;
use File::Spec::Functions qw(catfile);
use DateTime::Format::Strptime;

__PACKAGE__->connection(
    "dbi:SQLite:dbname=" . __PACKAGE__->db_file(),
    '', '',
    {
        RaiseError         => 1,
        PrintError         => 0,
        Warn               => 0,
        PrintWarn          => 0,
        AutoCommit         => 1,
        FetchHashKeyName   => 'NAME_lc',
        ShowErrorStatement => 1,
        ChopBlanks         => 1,
        RootClass          => 'DBIx::ContextualFetch',
    }
);

=head1 NAME

Smolder::DB

Database connections and Object-Relational-Mapper methods

=head1 SYNOPSIS

In your subclass,

 use base 'Smolder::DB';

and now you have Class::DBI::mysql methods ready for use.

 my $obj = Smolder::DB::Class->new;

=head1 DESCRIPTION

This class provides a single place for handling all of the database connections in Smolder.
It is a subclass of L<Class::DBI::mysql> and provides a base class 
for object persistence using Class::DBI.

It also provides a connect() method for getting a DBI connection from non Class::DBI code.

=head1 INTERFACE

=head2 dbh

Get the database handle.

=cut

sub dbh {
    return shift->db_Main;
}

=head2 commit

Commit the current transaction

=cut

sub commit {
    shift->db_Main->commit();
}

=head2 rollback

Rollback to the last C<commit>

=cut

sub dbi_rollback {
    shift->db_Main->rollback();
}

=head2 disconnect

Disconnects the current database handle stored in db_Main.

=cut

sub disconnect {
    return shift->db_Main->disconnect;
}

=head2 vars

Object method that returns a hash where the keys are the names of the 
columns and the values are the current values of those columns.

=cut

sub vars {
    my $self = shift;
    my %vars = map { $_ => $self->get($_) } ($self->columns);
    return %vars;
}

=head2 enum_values

Returns an arrayref containing the different values that an emum column can hold.
If used as a method on a subclass then it will use that class to determine which
table to use. Else, if called on the L<Smolder::DB> base class, it will accept
2 arguments, the first being the table to use.

    my $values = Smolder::DB::Foo->enum_values('some_column');

    my $values  = Smolder::DB->enum_values('table', 'some_column');

=cut

# SQLite doesn't support enums, so we just have to maintain this table
my %ENUMS = (
    preference => {
        email_type => [qw(full summary link)],
        email_freq => [qw(on_new on_fail never)],
    },
    project      => {graph_start => [qw(project year month week day)],},
    smoke_report => {format      => [qw(XML YAML)],},
);

sub enum_values {
    my $self = shift;
    my ($table, $column);

    if (ref $self || $self ne __PACKAGE__) {
        $table = $self->table();
    } else {
        $table = shift;
    }
    $column = shift;
    return $ENUMS{$table}->{$column} || [];
}

=head2 column_values

Returns an array ref of all the unique values in a table's column
This must be used in a sub class (it's an abstract method).

    my $values = Smolder::DB::Foo->column_values($column);

May also be passed a second optional argument which will be used to
limit the values returned to those that start with the given string.

For example, to retrieve all of the values for a given C<$column> that
begin with the letter 's':

    my $values = Smolder::DB::Foo->column_values($column, 's');

=cut

sub column_values {
    my ($self, $column, $substr) = @_;
    my $table = $self->table();
    my $sql   = qq(
        SELECT DISTINCT $column FROM $table WHERE $column IS NOT NULL
        AND $column != ''
    );
    my @bind_cols = ();

    # add the substring clause if we need to
    if ($substr) {
        $substr .= '%';
        $sql    .= " AND $column LIKE ? ";
        push(@bind_cols, $substr);
    }

    my $sth = Smolder::DB->db_Main()->prepare_cached($sql);
    $sth->execute(@bind_cols);
    my @values;
    while (my $row = $sth->fetchrow_arrayref()) {
        push(@values, $row->[0]);
    }
    return \@values;
}

=head2 refresh

TODO
CURRENT DOES NOT WORK!!!!

This object method will through away the object in memory and re-fetch
it from the database. This is useful when changes could be made in the db
in another thread (such as testing) and you want to make sure the object is
current.

=cut

# TODO - make this work
sub refresh {
    my $self = shift;
    $self->remove_from_object_index();
    my $class = ref $self;
    my $id    = $self->id;
    $self = undef;
    $self = $class->retrieve($id);
    return $self;
}

=head2 retrieve_all_sorted_by($column_name)

This object methed is exported from L<Class::DBI::Plugin::RetrieveAll>.  It takes
a name of the data field that you wish to sort by.  Otherwise it works
like a normal Class::DBI retrieve_all.  Please see L<Class::DBI::Plugin::RetrieveAll>
or more details.

=head2 retrieve_all_sort_field($column_name)

This object method changes the default retrieve_all() in the Class to be
auto-sorted by the specified column.  Please see
L<Class::DBI::Plugin::RetrieveAll> for more details.


=head2 db_file

Returns the full path to the SQLite DB file.

=cut

sub db_file {
    return catfile(DataDir, "smolder.sqlite");
}

=head2 run_sql_file

Given the runs the SQL contained in the file against out SQLite DB

    Smolder::DB->run_sql_file('/usr/local/smolder/foo.sql');

=cut

sub run_sql_file {
    my ($class, $file) = @_;
    open(my $IN, '<', $file) or die "Could not open file '$file' for reading: $!";

    require Smolder::DB;
    my $dbh = Smolder::DB->db_Main();

    my $sql = '';

    # read each line
    while (my $line = <$IN>) {

        # skip comments
        next if ($line =~ /^--/);
        $sql .= $line;

        # if we have a ';' at the end of the line then it should
        # be the end of the statement
        if ($line =~ /;\s*$/) {
            $dbh->do($sql)
              or die "Could not execute SQL '$sql': $!";
            $sql = '';
        }
    }

    close($file);
}

=head2 dump_database

Given the filename of where to put the dump, this method will create the SQL necessary
to restore the database to it's present state including all schema creationg statements.

    Smolder::DB->dump_database('/usr/local/smolder/dump.sql');

=cut

sub dump_database {
    my ($class, $file) = @_;

    # open the file we want to print to
    open(my $OUT, '>', $file)
      or die "Could not open file '$file' for writing: $!";

    # get the list of tables
    require Smolder::DB;
    my $dbh = Smolder::DB->db_Main();
    my $sth = $dbh->prepare(
        q(
        SELECT name FROM sqlite_master WHERE type = 'table'
        AND name NOT LIKE 'sqlite_%' AND sql NOT NULL
    )
    );
    $sth->execute();
    my (@tables, $table);
    $sth->bind_col(1, \$table);

    while ($sth->fetch) {
        push(@tables, $table);
    }
    $sth->finish();

    # now get the SQL for each table and output it
    foreach my $t (@tables) {

        # first the schema
        $sth = $dbh->prepare(
            q(
            SELECT sql FROM sqlite_master 
            WHERE type = 'table' AND name = ?
        )
        );
        $sth->execute($t);
        my $sql;
        $sth->bind_col(1, \$sql);
        while ($sth->fetch) {
            print $OUT "$sql;\n";
        }
        $sth->finish();

        # now the indexes
        $sth = $dbh->prepare(
            q(
            SELECT sql FROM sqlite_master
            WHERE type = 'index' AND tbl_name = ?
        )
        );
        $sth->execute($t);
        $sth->bind_col(1, \$sql);
        while ($sth->fetch) {
            print $OUT "$sql;\n" if ($sql);
        }
        $sth->finish();
        print $OUT "\n\n";

        # now get all of the data in this table
        $sth = $dbh->prepare(qq(SELECT * FROM $t));
        $sth->execute();
        while (my $row = $sth->fetchrow_arrayref) {

            # massage each value so we can create the SQL
            my @values;
            foreach my $value (@$row) {

                # NULLs
                if (!defined $value) {
                    $value = 'NULL';

                    # escape and quote it
                } else {
                    $value =~ s/"/\\"/g;
                    $value = qq("$value");
                }
                push(@values, $value);
            }

            # create the SQL
            my $sql = "INSERT INTO $t VALUES (" . join(', ', @values) . ");\n";
            print $OUT $sql;
        }

        print $OUT "\n\n";
    }
    close($OUT);
}

=head2 create_database

This method will create a brand new, completely empty database file for Smolder.

    Smolder::DB->create_database();

=cut

sub create_database {
    my $class = shift;
    my $file  = $class->db_file();

    # create a new file by this name whether it exists or not
    open(FH, '>', $file) or die "Could not open file '$file' for writing: $!";
    close(FH) or die "Could not close file '$file': $!";

    my @files   = glob(catfile(SQLDir, '*.sql'));
    foreach my $f (@files) {
        eval { $class->run_sql_file($f) };
        die "Couldn't load SQL file $f! $@" if $@;
    }

    # Set the db_version
    my $version = $Smolder::VERSION;
    my $dbh     = $class->db_Main;
    eval { $dbh->do("UPDATE db_version set db_version=$version") };
    die "Could not update db_version! $@" if $@;
}

=head2 unique_failure_msg 

Given a DB failure message, will return true if the message was a failure due to a
failed UNIQUE contstraint, else will return false.

    eval { $class->create(%args) };
    if( $@ ) {
        die unless Smolder::DB->unique_failure_msg($@);
    }

=cut

sub unique_failure_msg {
    my ($class, $msg) = @_;
    return $msg =~ /not unique/i;
}

=head2 format_datetime

Given a L<DateTime> object, return the string we want to store in the database

=cut

sub format_datetime {
    my ($class, $dt) = @_;
    return $dt->strftime('%Y-%m-%d %H:%M:%S');
}

=head2 parse_datetime

Given a date string, return the L<DateTime> object it represents.

=cut

my $DATE_FMT = DateTime::Format::Strptime->new(
    pattern   => '%Y-%m-%d %H:%M:%S',
    time_zone => 'local'
);
sub parse_datetime {
    my ($class, $string) = @_;
    return $DATE_FMT->parse_datetime($string);
}

1;

__END__

=head1 SEE ALSO 

=over

=item L<DBI>

=item L<Class::DBI>

=item L<Class::DBI::SQLite>

=item L<Class::DBI::Plugin::RetrieveAll>

=back