package DBIx::MySQLSequence;

# The DBIx::MySQLSequence package implements an emulation layer that
# provides ostensibly "real" sequences on MySQL.
#
# MySQL provides an AUTO_INCREMENT extention to SQL92 to implement
# incrementing ids for primary keys.
#
# However, this is not a very nice way to do them. I won't get into
# the reasoning in depth here, but primarily there are advantages
# to be had by knowing the value you are going to use BEFORE you
# insert the record into the database.
#
#
# What is a sequence?
# All a sequence is, is a source of guarenteed unique numbers. This
# may or may not be in order. In DBIx::MySQLSequence, sequences
# are returned in order. This may not be the case in the future.
#
# The module works by creating a "sequence table", a single table
# where each table record represents a single sequence.
#
#
# DBIx::MySQLSequence Features:
# - Sequence names are case insensitive.
# - Sequence names can be any string 1 to 32 chars in length.
# - Yes, any string, spaces, #$%^@!, and all... This may change.
# - Sequence values use BIGINT fields, so the start, increment
#   and current values can be any integer  between 
#   -9223372036854775808 and 9223372036854775807.
# - The module is safe for multiple database users or connections.
# - The module is not transaction friendly. ( See below )
# - The module is probably NOT thread safe ( Is DBI thread safe? )
#
#
# Transaction Safety
# Because the sequences are emulated through tables, they fall
# within the realm of the transaction. If you are using transactions
# on MySQL, you should have a seperate connection open somewhere to
# do addition statements outside the transaction. Use that to pull
# the sequence values.
# 
# Attempting to do anything via DBIx::MySQLSequence with a handle in
# a non-autocommit state will cause an error. YOU HAVE BEEN WARNED!
#
#
# Permissions
# At the time the first sequence is created, you will need permission
# to create a table in the database. Otherwise, you need INSERT, UPDATE
# and DELETE on the sequence table, named "mysql__sequences" by default.
#
#
# Interface
# exists - Does a sequence exist.
# create - Create a sequence.
# drop - Drop a sequence.
# reset - Resets the current value to the start value.
# currval - Get current value.
# nextval - Get next value.
# removeSequenceSupport - Removes the entire sequence table.
#
#
# Miscellaneous
# This module was created by extracting a set of relavent functionality
# from various modules in the AppSpace Development System.
# AppSpace is available at http://ali.as/AppSpace/.
# The interface is loosely based on DBIx::OracleSequence.
# Code copyright Adam Kennedy 2001-2002.
# This code is released under the terms of Perl itself.

use strict;
use UNIVERSAL 'isa';
use DBI;

use vars qw{$MYSQL_SEQUENCE_TABLE};
BEGIN {
	$MYSQL_SEQUENCE_TABLE = "_sequences";
}
	
# Create a generic handle
sub new {
	my $class = shift;
	my $dbh = shift or return $class->_andError( "Missing database handle argument" );
	my $name = shift or return $class->_andError( "Missing sequence name argument" );

	# Create the object
	my $self = {
		dbh => $dbh,
		name => $name,
		};
	bless $self, $class;
	
	return $self;
}

sub dbh { $_[0]->{dbh} }
sub name { $_[0]->{name} }





#####################################################################
# Main Interface

sub exists {
	my $self = ref $_[0] ? shift : $_[0]->new( @_ ) or return undef;
	
	# Does the sequence table exist?
	my $rv = $self->_sequenceTableExists();
	return $rv unless $rv;
	
	# Is the sequence entry in the table
	return $self->_sequenceExists();
}
	
sub create {
	my $self = ref $_[0] ? shift : $_[0]->new( @_ ) or return undef;

	# Does the sequence table exist?
	my $rv = $self->_sequenceTableExists();
	return undef unless defined $rv;
	unless ( $rv ) {
		# Create the sequence table
		$rv = $self->_createSequenceTable() or return undef;
	}
	
	# Add the sequence to the table
	my $rv = $self->_createSequence( $_[3], $_[4] );
	return $rv ? ref $self ? 1 : $self : undef;
}
	
sub drop {
	my $self = ref $_[0] ? shift : $_[0]->new( @_ ) or return undef;
	
	# Does the sequence table exist?
	my $rv = $self->_sequenceTableExists() or return undef;
	
	# Remove the sequence from the table
	return $self->_dropSequence();
}

sub reset {
	my $self = ref $_[0] ? shift : $_[0]->new( @_ ) or return undef;

	# Does the sequence exist?
	my $rv = $self->_sequenceExists();
	return undef unless defined $rv;
	return $self->_andError( "Sequence '$self->{self}' does not exist" ) unless $rv;
	
	# Set it's value to the start value
	return $self->_dbVoid( qw{UPDATE $MYSQL_SEQUENCE_TABLE
		SET sequence_value = sequence_start
		WHERE sequence_name = ?}, [ $self->{name} ] );	
}
	
sub currval {
	my $self = ref $_[0] ? shift : $_[0]->new( @_ ) or return undef;
	
	# Assume the sequence table exists, as we will return an error
	# if the table doesn't exist OR if the record does not exist.
	my $rv = $self->_dbValue( qw{SELECT sequence_value
		FROM $MYSQL_SEQUENCE_TABLE
		WHERE sequence_name = ?}, [ lc $self->{name} ] );
	return undef unless $rv;
	return $$rv;
}

sub nextval {
	my $self = ref $_[0] ? shift : $_[0]->new( @_ ) or return undef;
	
	# Assume the sequence table exists, as we will return an error
	# if the table doesn't exist OR if the record does not exist.

	# Increment the sequence
	my $rv = $self->_dbVoid( qw{UPDATE $MYSQL_SEQUENCE_TABLE
		SET sequence_value = LAST_INSERT_ID(sequence_value + sequence_increment)
		WHERE sequence_name = ?}, [ lc $self->{name} ] );
	return undef unless $rv;
	
	# Get the next value
	my $value = $self->$self->_dbValue( "SELECT LAST_INSERT_ID()" );
	return $value ? $$value : undef;
}





# Remove support completely. ( Get rid of the table when no longer needed )
sub removeSequenceSupport {
	my $class = shift;
	
	# Make sure we are called as a static method
	if ( ref $class ) {
		return $class->_andError( "removeSequenceSupport cannot be called as an object method" );
	}
	my $dbh = shift or return $class->_andError( "Missing database handle argument" );

	# Cheat a little to actually become an object, so the handle
	# provisioning in _execute works
	my $self = bless \{ dbh => $dbh, name => undef }, $class;
	return $self->_dropSequenceTable();
}



#####################################################################
# Main Private Methods

# Does the sequence table exist
sub _sequenceTableExists {
	my $self = shift;
	
	# Get the list of tables
	my $tables = $self->_dbList( 'SHOW TABLES' );
	return undef unless defined $tables;
	return 0 unless $tables;
	foreach ( @$tables ) {
		# Found the table
		return 1 if $_ eq $MYSQL_SEQUENCE_TABLE;
	}
	return 0;
}

# Does a single sequence exist within the sequence table
sub _sequenceExists {
	my $self = shift;
	
	# Try to find the record
	my $rv = $self->_dbValue( qw{SELECT COUNT(*) FROM $MYSQL_SEQUENCE_TABLE"
		WHERE sequence_name = ?}, [ lc $self->{name} ] );
	return undef unless defined $rv;
	return (ref $rv && $$rv) ? 1 : 0;
}
	
# Create the sequence table
sub _createSequenceTable {
	my $self = shift;
	return $self->_dbVoid( qq{CREATE TABLE $MYSQL_SEQUENCE_TABLE (
		sequence_name CHAR(32) NOT NULL PRIMARY KEY,
		sequence_start BIGINT NOT NULL DEFAULT 1,
		sequence_increment BIGINT NOT NULL DEFAULT 1,
		sequence_value BIGINT NOT NULL DEFAULT 1
		)} );
}

# Drop the sequence table
sub _dropSequenceTable {
	my $self = shift;
	return $self->_dbVoid( qq{DROP TABLE $MYSQL_SEQUENCE_TABLE} );
}

# Add a single sequence to the table
sub _createSequence {
	my $self = shift;
	my $start = $_[0] =~ /^-?\d+$/ ? shift : 1;
	my $increment = $_[0] =~ /^-?\d+$/ ? shift : 1;
	
	# Assume the sequence table exists
	return $self->_dbVoid( qw{INSERT INTO $MYSQL_SEQUENCE_TABLE
		( sequence_name, sequence_start, sequence_increment, sequence_value )
		VALUES ( ?, $start, $increment, $start )}, [ lc $self->{name} ] );
}

# Remove a single sequence from the table
sub _dropSequence {
	my $self = shift;
	
	# Assume the sequence table exists
	return $self->_dbVoid( qw{DELETE FROM $MYSQL_SEQUENCE_TABLE
		WHERE sequence_name = ?}, [ lc $self->{name} ] );
}

# Get the entire record hash for a sequence
sub _getSequenceDetails {
	my $self = shift;
	
	# Pull the entire record
	my $record = $self->_dbRecord( qw{SELECT * FROM $MYSQL_SEQUENCE_TABLE
		WHERE sequence_name = ?}, [ lc $self->{name} ] );
	return undef unless defined $record;
	return $record || $self->andError( "Sequence '$self->{name}' does not exist" );
}





#####################################################################
# Database Methods

use constant FORMAT_VOID      => 0;
use constant FORMAT_VALUE     => 1;
use constant FORMAT_LIST      => 2;
use constant FORMAT_RECORD    => 3;

sub _dbVoid {
	my ($self, $sql, $arguments) = @_;
	return $self->execute( $sql, $arguments || [], FORMAT_VOID );
}

sub _dbValue {
	my ($self, $sql, $arguments) = @_;
	return $self->execute( $sql, $arguments || [], FORMAT_VALUE );
}

sub _dbList {
	my ($self, $sql, $arguments) = @_;
	return $self->execute( $sql, $arguments || [], FORMAT_LIST );
}

sub _dbRecord {
	my ($self, $sql, $arguments) = @_;
	return $self->execute( $sql, $arguments || [], FORMAT_RECORD );
}

sub _execute {
	my $self = shift;
	my $sql = shift;
	my $arguments = shift;
	my $rformat = shift;
	unless ( ref $arguments eq 'ARRAY' ) {
		return $self->andError( "Arguments list is not an array reference" );
	}
	
	# Make sure we have a connection,
	# and arn't in a transaction.
	return $self->andError( "Database connection missing" ) unless $self->{dbh};
	unless ( $self->{dbh}->{AutoCommit} == 1 ) {
		return $self->andError( "DBIx::MySQLSequence will not inside transactions."
			. " Use a seperate connection for getting sequence values." );
	}	

	# Create the statement handle using the sql
	my $sth = $self->{dbh}->prepare( $sql );
	return $self->andError( "SQL error during prepare: " . $self->{dbh}->errstr ) unless $sth;
	
	# Looks good. Execute the statement
	my $result = $sth->execute( @$arguments);
	unless ( $result ) {
		$self->andError( "SQL error during execute: " . $sth->errstr );
		$sth->finish;
		return undef;
	}
	
	# Format the response data
	my $data;
	if ( $rformat == FORMAT_VOID ) {
		# It worked, return true
		$data = 1;

	} elsif ( $rformat == FORMAT_VALUE ) {
		# Get a single value
		my $rv = $sth->fetch;
		$data = $rv ? \$rv->[ 0 ] : 0;
		
	} elsif ( $rformat == FORMAT_LIST ) {
		# Get a list
		my ($rv, @list) = ();
		push @list, $rv->[ 0 ] while $rv = $sth->fetch;
		$data = scalar @list ? \@list : 0;
		
	} elsif ( $rformat == FORMAT_RECORD ) {
		# Get a single hash reference
		my $rv = $sth->fetchrow_hashref( 'NAME_lc' );
		$data = $rv ? $rv : 0;
		
	} else {
		$sth->finish;
		$self->andError( "Statement executed successfully, but return format is invalid" );
	}

	# Finish and return
	$sth->finish;	
	return $data;
}





#####################################################################
# Error handling

# Global error
use vars qw{$errstr};
BEGIN { $errstr = '' }

# Set an error string and return
sub _andError {
	my $either = shift;
	if ( ref $either ) {
		$either->{_errstr} = shift;
	} else {
		$errstr = shift;
	}
	return undef;
}

# Fetch an error message
sub errstr {
	my $either = shift;
	return ref $either ? $either->{errstr} : $errstr;
}

1;