CPAN::WWW::Testers::Generator::Database - DB handling code.

  my $dbi = CPAN::WWW::Testers::Generator::Database->new(database => $db);
  my @rows = $dbi->get_query($sql);
  $dbi->do_query($sql);

  my $iterator = $dbi->get_query_interator($sql);
  while(my $row = $iterator->()) {
    # do something
  }

  Barbie, <barbie@cpan.org>
  for Miss Barbell Productions <http://www.missbarbell.co.uk>.

  Copyright (C) 2008 Barbie for Miss Barbell Productions.

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

package CPAN::WWW::Testers::Generator::Database;

use warnings;
use strict;
use vars qw($VERSION);

$VERSION = '0.30';

#----------------------------------------------------------------------------

# -------------------------------------
# Library Modules

use DBI;
use File::Basename;
use File::Path;

# -------------------------------------
# Variables

use constant    DATABASE    => 'cpanstats.db';

# -------------------------------------
# Routines

sub new {
    my ($class,%hash) = @_;
    return  unless($hash{database});

    my $self = {database => $hash{database}};
    bless $self, $class;

    $self->{AutoCommit} = $hash{AutoCommit} || 0;

    my $exists = -f $self->{database};

    mkpath(dirname($self->{database}))  unless($exists);

    $self->{dbh} = DBI->connect("DBI:SQLite:dbname=$self->{database}", "", "", {
        RaiseError => 1,
        AutoCommit => $self->{AutoCommit},
        sqlite_handle_binary_nulls => 1,
    });
    return  unless($self->{dbh});

    if(!$exists) {
        eval { $self->_dbh_create($self->{dbh},$self->{database}) };
        die "Failed to create database: $@"  if($@);
    }

    return $self;
}

sub DESTROY {
    my $self = shift;
    return      unless($self->{dbh});

    $self->{dbh}->commit    unless($self->{AutoCommit});
    $self->{dbh}->disconnect;
}

sub do_commit {
    my $self = shift;
    $self->{dbh}->commit;
}

sub do_query {
    my ($self,$sql,@fields) = @_;
    my $sth;

    # prepare the sql statement for executing
    eval { $sth = $self->{dbh}->prepare($sql); };
    unless($sth) {
        die sprintf "ERROR: %s : %s\n", $self->{dbh}->errstr, $sql;
    }

    # execute the SQL using any values sent to the function
    # to be placed in the sql
    unless($sth->execute(@fields)) {
        die sprintf "ERROR: %s : %s : [%s]\n", $sth->errstr, $sql, join(',',@fields);
    }

    $sth->finish;
}

sub get_query {
    my ($self,$sql,@fields) = @_;
    my ($sth,@rows);

    eval { $sth = $self->{dbh}->prepare($sql); };
    unless($sth) {
        die sprintf "ERROR: %s : %s\n", $self->{dbh}->errstr, $sql;
    }

    unless($sth->execute(@fields)) {
        die sprintf "ERROR: %s : %s : [%s]\n", $sth->errstr, $sql, join(',',@fields);
    }

    while(my $row = $sth->fetchrow_arrayref) {
        push @rows, [@$row];
    }
    return @rows;
}

sub get_query_iterator {
    my ($self,$sql,@fields) = @_;
    my ($sth,@rows);

    eval { $sth = $self->{dbh}->prepare($sql); };
    unless($sth) {
        die sprintf "ERROR: %s : %s\n", $self->{dbh}->errstr, $sql;
    }

    unless($sth->execute(@fields)) {
        die sprintf "ERROR: %s : %s : [%s]\n", $sth->errstr, $sql, join(',',@fields);
    }

    return sub { return $sth->fetchrow_arrayref }
}

sub _dbh_create {
    my ($self,$dbh,$db) = @_;
    my @sql;

    if($db =~ /cpanstats.db$/) {
        push @sql,
            'PRAGMA auto_vacuum = 1',
            'CREATE TABLE cpanstats (
                                                    id            INTEGER PRIMARY KEY,
                                                    state         TEXT,
                                                    postdate      TEXT,
                                                    tester        TEXT,
                                                    dist          TEXT,
                                                    version       TEXT,
                                                    platform      TEXT,
                                                    perl          TEXT,
                                                    osname        TEXT,
                                                    osvers        TEXT,
                                                    date          TEXT)',

            'CREATE INDEX distverstate ON cpanstats (dist, version, state)',
            'CREATE INDEX ixperl ON cpanstats (perl)',
            'CREATE INDEX ixplat ON cpanstats (platform)',
            'CREATE INDEX ixdate ON cpanstats (postdate)';
    } else {
        push @sql,
            'PRAGMA auto_vacuum = 1',
            'CREATE TABLE articles (
                                                    id            INTEGER PRIMARY KEY,
                                                    article       TEXT)';
    }

    $dbh->do($_)    for(@sql);
}


__END__