package Module::CoreList::DBSchema;

use strict;
use warnings;
use Clone qw[clone];
use Module::CoreList;
use SQL::Abstract;
use vars qw[$VERSION];

$VERSION = '0.06';

my $tables = {
   cl_perls => [
      'perl_ver VARCHAR(20) NOT NULL',
      'released VARCHAR(10)',
    ],
    cl_versions => [
      'perl_ver VARCHAR(20) NOT NULL',
      'mod_name VARCHAR(300) NOT NULL',
      'mod_vers VARCHAR(30)',
      'deprecated BOOL',
    ],
    cl_families => [
      'perl_ver VARCHAR(20) NOT NULL',
      'family VARCHAR(20) NOT NULL',
    ],
    cl_upstream => [
      'mod_name VARCHAR(300) NOT NULL',
      'upstream VARCHAR(20)',
    ],
    cl_bugtracker => [
      'mod_name VARCHAR(300) NOT NULL',
      'url TEXT',
    ],
};

my $queries = {
  corelist => [ 'select cl_perls.perl_ver, mod_vers, released, deprecated from cl_versions,cl_perls where cl_perls.perl_ver = cl_versions.perl_ver and mod_name = ? order by cl_versions.perl_ver', 1 ],
};

my $sql = SQL::Abstract->new();

sub new {
  my $package = shift;
  my %opts = @_;
  $opts{lc $_} = delete $opts{$_} for keys %opts;
  my $self = bless \%opts, $package;
  return $self;
}

sub tables {
  my $clone = clone( $tables );
  return %{ $clone } if wantarray;
  return $clone;
}

sub data {
  my $self = shift;
  my %opts = @_;
  $opts{lc $_} = delete $opts{$_} for keys %opts;
  my $prefix = $opts{prefix} || '';
  my $data = [];
  foreach my $perl ( keys %Module::CoreList::version ) {
    push @{ $data }, [ $sql->insert( $prefix . 'cl_perls', [ $perl, $Module::CoreList::released{$perl} ] ) ];
    foreach my $mod ( keys %{ $Module::CoreList::version{ $perl } } ) {
      my $modver = $Module::CoreList::version{ $perl }{ $mod };
      $modver = '' unless $modver;
      my $deprecated = $Module::CoreList::deprecated{ $perl }{ $mod } || 0;
      push @{ $data }, [
        $sql->insert( $prefix . 'cl_versions', [ $perl, $mod, $modver, $deprecated ] )
      ];
    }
  }
  foreach my $family ( keys %Module::CoreList::families ) {
    push @{ $data }, [
      $sql->insert( $prefix . 'cl_families', [ $_, $family ] )
    ] for @{ $Module::CoreList::families{ $family } };
  }
  foreach my $mod ( keys %Module::CoreList::upstream ) {
    push @{ $data }, [
      $sql->insert( $prefix . 'cl_upstream', [ $mod, ( $Module::CoreList::upstream{ $mod } || '' ) ] )
    ];
  }
  foreach my $mod ( keys %Module::CoreList::bug_tracker ) {
    push @{ $data }, [
      $sql->insert( $prefix . 'cl_bugtracker', [ $mod, ( $Module::CoreList::bug_tracker{ $mod } || '' ) ] )
    ];
  }
  return @{ $data } if wantarray;
  return $data;
}

sub queries {
  return keys %{ $queries };
}

sub query {
  my $self = shift;
  my $query = shift || return;
  return unless exists $queries->{ $query };
  my $sql = $queries->{ $query };
  return @{ $sql } if wantarray;
  return $sql;
}

q[Modules are our business];

__END__

=head1 NAME

Module::CoreList::DBSchema - A database schema for Module::CoreList

=head1 SYNOPSIS

  # this requires DBI and DBD::SQLite which are available from CPAN

  use strict;
  use warnings;
  use DBI;
  use Module::CoreList::DBSchema;
  
  $|=1;
  
  my $dbh = DBI->connect('dbi:SQLite:dbname=corelist.db','','') or die $DBI::errstr;
  $dbh->do(qq{PRAGMA synchronous = OFF}) or die $dbh->errstr;
  
  my $mcdbs = Module::CoreList::DBSchema->new();
  
  # create tables
  
  my %tables = $mcdbs->tables();
  
  print "Creating tables ... ";
  
  foreach my $table ( keys %tables ) {
    my $sql = 'CREATE TABLE IF NOT EXISTS ' . $table . ' ( ';
    $sql .= join ', ', @{ $tables{$table} };
    $sql .= ' )';
    $dbh->do($sql) or die $dbh->errstr;
    $dbh->do('DELETE FROM ' . $table) or die $dbh->errstr;
  }
  
  print "DONE\n";
  
  # populate with data
  
  my @data = $mcdbs->data();
  
  print "Populating tables ... ";
  
  $dbh->begin_work;
  
  foreach my $row ( @data ) {
    my $sql = shift @{ $row };
    my $sth = $dbh->prepare_cached($sql) or die $dbh->errstr;
    $sth->execute( @{ $row } ) or die $dbh->errstr;
  }
  
  $dbh->commit;
  
  print "DONE\n";
  
  # done

=head1 DESCRIPTION

Module::CoreList::DBSchema provides methods for building a database from the 
information that is provided by L<Module::CoreList>.

=head1 CONSTRUCTOR

=over

=item C<new>

Creates a new Module::CoreList::DBSchema object.

  my $mcdbs = Module::CoreList::DBSchema->new();

=back

=head1 METHODS

=over

=item C<tables>

In a scalar context returns a hashref data structure keyed on table name.

In a list context returns a list of the same data structure.

  my %tables = $mcdbs->tables();
  
  foreach my $table ( keys %tables ) {
    my $sql = 'CREATE TABLE IF NOT EXISTS ' . $table . ' ( ';
    $sql .= join ', ', @{ $tables{$table} };
    $sql .= ' )';
    $dbh->do($sql) or die $dbh->errstr;
    $dbh->do('DELETE FROM ' . $table) or die $dbh->errstr;
  }
  
=item C<data>

In a list context returns a list of arrayrefs which contain a SQL statement
as the first element and the remaining elements being bind values for the SQL
statement.

In a scalar context returns an arrayref which contains the above arrayrefs.

  my @data = $mcdbs->data();
  
  foreach my $row ( @data ) {
    my $sql = shift @{ $row };
    my $sth = $dbh->prepare_cached($sql) or die $dbh->errstr;
    $sth->execute( @{ $row } ) or die $dbh->errstr;
  }

You may provide some optional arguments:

  prefix, a string to prefix to the table names in the resultant SQL;
  
=item C<queries>

Returns a list of the available SQL queries.

  my @queries = $mcdbs->queries();

=item C<query>

Takes one argument, the name of a query to lookup.

Returns in list context a list consisting of a SQL string and a flag indicating whether the
SQL string includes placeholders.

In scalar context returns an array reference containing the same as above.

  my $sql = $mcdbs->query('corelist');

=back

=head1 AUTHOR

Chris C<BinGOs> Williams <chris@bingosnet.co.uk>

=head1 LICENSE

Copyright E<copy> Chris Williams

This module may be used, modified, and distributed under the same terms as Perl itself. Please see the license that came with your Perl distribution for details.

=head1 SEE ALSO

L<Module::CoreList>

L<DBI>

=cut