view release on metacpan or  search on metacpan

lib/DBD/PgLite.pm  view on Meta::CPAN

};

# Make sure sequence environment is sane and yield a
# database handle to sequence functions
sub _seq_init {
	my $sn = lc(shift);
	my $dbh = getDbh();
	# Create sequence table if it does not exist
	my $check_tbl = "select name from sqlite_master where name = ? and type = 'table'";
	unless ($dbh->selectrow_array($check_tbl, {}, 'pglite_seq')) {
		$dbh->do("create table pglite_seq (sequence_name text primary key, last_value int, is_locked int, is_called int)");
	}
	my $check_seq = "select sequence_name from pglite_seq where sequence_name = ?";
	# Autocreate sequence if it does not exist
	unless ($dbh->selectrow_array($check_seq,{},$sn)) {
		$dbh->do("insert into pglite_seq (sequence_name, last_value, is_locked, is_called) values (?,?,?,?)",
				 {}, $sn, 1, 1, 0);
		# Find a matching table, if possible, and set last_value based on that
		my $tn = $sn;
		$tn =~ s/_seq$//;
		my ($val,$col) = (0,'');
		while (!$val && $tn=~/_+[a-z]*$/) {
			$col = ($col ? "${1}_$col" : $1) if $tn =~ s/_+([a-z]*)$//;
			if ($dbh->selectrow_array($check_tbl, {}, $tn)) {
				eval {
					$val = $dbh->selectrow_array("select max($col) from $tn");
				};
			}
		}
		if (int($val) > 0) {
			$dbh->do("update pglite_seq set last_value = ?, is_called = 1 where sequence_name = ?",
					 {}, int($val), $sn);
		}
		# unlock sequence before we continue
		$dbh->do("update pglite_seq set is_locked = 0 where sequence_name = ?",{},$sn);
	}
	return $dbh;
}


# Advance the sequence object to its next value and return that
# value.
sub _nextval {
	my $sn = lc(shift);
	my $dbh = _seq_init($sn);
	my $tries;
	while (1) {
		my $rc = $dbh->do("update pglite_seq set last_value = last_value + 1, is_locked = 1 where sequence_name = ? and is_locked = 0 and is_called = 1",{},$sn);
		last if $rc && $rc > 0;
		$rc = $dbh->do("update pglite_seq set is_locked = 1 where sequence_name = ? and is_locked = 0 and is_called = 0",{},$sn);
		last if $rc && $rc > 0;
		Time::HiRes::sleep(0.05);
		die "Too many tries trying to update sequence '$sn' - need manual fix?" if ++$tries > 20;
	}
	my $sval = $dbh->selectrow_array("select last_value from pglite_seq where sequence_name = ?",{},$sn);
	$dbh->do("update pglite_seq set is_locked = 0, is_called = 1 where sequence_name = ? and is_locked = 1",{},$sn);
	setLastval($sn);
	setCurrval($sn,$sval);
	return $sval;
}

# Return the value most recently obtained by nextval for this sequence
# in the current session.
sub _currval {
	my $sn = lc(shift);
	my $val = getCurrval($sn);

lib/DBD/PgLite.pm  view on Meta::CPAN

sub _setval {
	my ($sn,$val,$called) = @_;
	$sn = lc($sn);
	$val = int($val);
	die "ERROR: Value of sequence '$sn' must be a positive integer" unless $val;
	$called = 1 unless defined($called);
	$called = $called ? 1 : 0;
	my $dbh = _seq_init($sn);
	my $tries;
	while (1) {
		my $rc = $dbh->do("update pglite_seq set last_value = ?, is_called = ? where sequence_name = ? and is_locked = 0",
						  {}, $val, $called, $sn);
		last if $rc && $rc > 0;
		Time::HiRes::sleep(0.05);
		die "Too many tries trying to update sequence '$sn' - need manual fix?" if ++$tries > 20;
	}
	return $val;
}


# Utility functions for succinct expression below