view release on metacpan or  search on metacpan

lib/OOPS/sqlite2.pm  view on Meta::CPAN

package OOPS::sqlite2;

@ISA = qw(OOPS::DBO Exporter);
@EXPORT = qw(
	tabledefs
	table_list
	db_initial_values
	initial_query_set
	$big_blob_size
	$retry_count
);

use strict;
use warnings;
use Carp qw(confess);

our $big_blob_size = 900*1024;

# PRAGME integrity_check; ???

sub new
{
	my $pkg = shift;
	my $dbo = OOPS::DBO->new(@_);
	$dbo->{dbms} = 'sqlite2';
	bless $dbo, $pkg;
}

sub tmode {}

sub lock_object {}

sub deadlock_rx
{
	return (
		qr/database is locked(?:\(\d+\) at dbdimp\.c line )?/,
		qr/unable to open database file\(\d+\) at dbdimp\.c line/,
	);
}

sub nodata_rx
{
	return qr/no such table: \S+object/;
}

sub initialize
{
	my $dbo = shift;

	my $dbh = $dbo->{dbh};
	$dbh->{sqlite_handle_binary_nulls} = 1;

	# 
	# SQLite will sometimes error out with a locked database
	# error when it should have just waited instead.  Oh well.
	#
	# http://rt.cpan.org/Ticket/Display.html?id=11680
	#
	$dbh->func(10_000, 'busy_timeout');

	my $sync = $dbo->{default_synchronous} || $ENV{OOPS_SYNC};
	if ($sync) {
		my $sm = $dbh->prepare("PRAGMA default_synchronous = $sync;") || confess $dbh->errstr;
		$sm->execute || confess $sm->errstr;
	}

	$dbo->{sqlite_version} = 2;
}

sub tabledefs
{
	my $x = <<'END';

	CREATE TABLE TP_object (
		id		INTEGER PRIMARY KEY,
		loadgroup	BIGINT, 
		class 		VARCHAR(255), 		# ref($object)
		otype		CHAR(1),		# 'S'calar/ref, 'A'rray, 'H'ash
		virtual		CHAR(1),		# load virutal ('V' or '0')
		reftarg		CHAR(1),		# reference target ('T' or '0')
		rfe		CHAR(1),		# reserved for future expansion
		alen		INT,			# array length
		refs		INT, 			# references
		counter		INT,
		gcgeneration	INT DEFAULT 1
		);

	CREATE INDEX TP_group_index ON TP_object (loadgroup);

	CREATE TABLE TP_attribute (
		id		BIGINT NOT NULL, 
		pkey		VARCHAR(128) NOT NULL, 
		pval		VARCHAR(255), 
		ptype		VARCHAR(1),		# type '0'-normal or 'R'eference 'B'ig
		PRIMARY KEY (id, pkey));

	CREATE INDEX TP_value_index ON TP_attribute (pval);

	CREATE TABLE TP_big (
		id		BIGINT NOT NULL, 
		pkey		VARCHAR(128) NOT NULL, 
		fragno		INT,
		pval		TEXT,
		PRIMARY KEY (id, pkey, fragno));

END

	$x =~ s/#.*//mg;
	return $x;
}

sub lock
{
	return 1;
}

sub table_list
{
	return (qw(TP_object TP_attribute TP_big));