DBIx::DBSchema::DBD::SQLite - SQLite native driver for DBIx::DBSchema

DBIx-DBSchema documentation Contained in the DBIx-DBSchema distribution.

Index

Code Index:

NAME

Top

DBIx::DBSchema::DBD::SQLite - SQLite native driver for DBIx::DBSchema

SYNOPSIS

Top

use DBI; use DBIx::DBSchema;

$dbh = DBI->connect('dbi:SQLite:tns_service_name', 'user','pass'); $schema = new_native DBIx::DBSchema $dbh;

DESCRIPTION

Top

This module implements a SQLite-native driver for DBIx::DBSchema.

AUTHOR

Top

Jesse Vincent <jesse@bestpractical.com>

API

Top

columns CLASS DBI_DBH TABLE

Given an active DBI database handle, return a listref of listrefs (see perllol), each containing six elements: column name, column type, nullability, column length, column default, and a field reserved for driver-specific use (which for sqlite is whether this col is a primary key)

primary_key CLASS DBI_DBH TABLE

Given an active DBI database handle, return the primary key for the specified table.

unique CLASS DBI_DBH TABLE

Given an active DBI database handle, return a hashref of unique indices. The keys of the hashref are index names, and the values are arrayrefs which point a list of column names for each. See "HASHES OF LISTS" in perldsc and DBIx::DBSchema::ColGroup.

index CLASS DBI_DBH TABLE

Given an active DBI database handle, return a hashref of (non-unique) indices. The keys of the hashref are index names, and the values are arrayrefs which point a list of column names for each. See "HASHES OF LISTS" in perldsc and DBIx::DBSchema::ColGroup.

DBIx-DBSchema documentation Contained in the DBIx-DBSchema distribution. 
package DBIx::DBSchema::DBD::SQLite;

use strict;
use vars qw($VERSION @ISA %typemap);
use DBIx::DBSchema::DBD;

$VERSION = '0.02';
@ISA = qw(DBIx::DBSchema::DBD);

%typemap = (
  'SERIAL' => 'INTEGER PRIMARY KEY AUTOINCREMENT',
);


sub columns {
    my ( $proto, $dbh, $table ) = @_;
    my $sth  = $dbh->prepare('PRAGMA table_info($table)');
        $sth->execute();
    my $rows = [];

    while ( my $row = $sth->fetchrow_hashref ) {

        #  notnull #  pk #  name #  type #  cid #  dflt_value
        push @$rows,
            [
            $row->{'name'},    
            $row->{'type'},
            ( $row->{'notnull'} ? 0 : 1 ), 
            undef,
            $row->{'dflt_value'}, 
            $row->{'pk'}
            ];

    }

    return $rows;
}



sub primary_key {
  my ($proto, $dbh, $table) = @_;

        my $cols = $proto->columns($dbh,$table);
        foreach my $col (@$cols) {
                return ($col->[1]) if ($col->[5]);
        }
        
        return undef;
}




sub unique {
  my ($proto, $dbh, $table) = @_;
  my @names;
        my $indexes = $proto->_index_info($dbh, $table);
   foreach my $row (@$indexes) {
        push @names, $row->{'name'} if ($row->{'unique'});

    }
    my $info  = {};
        foreach my $name (@names) {
                $info->{'name'} = $proto->_index_cols($dbh, $name);
        }
    return $info;
}



sub index {
  my ($proto, $dbh, $table) = @_;
  my @names;
        my $indexes = $proto->_index_info($dbh, $table);
   foreach my $row (@$indexes) {
        push @names, $row->{'name'} if not ($row->{'unique'});

    }
    my $info  = {};
        foreach my $name (@names) {
                $info->{'name'} = $proto->_index_cols($dbh, $name);
        }

  return $info;
}



sub _index_list {

        my $proto = shift;
        my $dbh = shift;
        my $table = shift;

my $sth  = $dbh->prepare('PRAGMA index_list($table)');
$sth->execute();
my $rows = [];

while ( my $row = $sth->fetchrow_hashref ) {
    # Keys are "name" and "unique"
    push @$rows, $row;

}

return $rows;
}



sub _index_cols {
        my $proto  = shift;
        my $dbh = shift;
        my $index = shift;
        
        my $sth  = $dbh->prepare('PRAGMA index_info($index)');
        $sth->execute();
        my $data = {}; 
while ( my $row = $sth->fetchrow_hashref ) {
    # Keys are "name" and "seqno"
        $data->{$row->{'seqno'}} = $data->{'name'};
}
        my @results; 
        foreach my $key (sort keys %$data) {
              push @results, $data->{$key}; 
        }

        return \@results;

}


1;