view release on metacpan or  search on metacpan

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

   },
   
   {
	name   => 'localtime',
	argnum => 0,
	func   => sub {  _pg_current('time',0) }
   },
   
   {
	name   => 'localtimestamp',
	argnum => 0,
	func   => sub {  _pg_current('timestamp',0) }
   },

   {
	name   => 'now',
	argnum => 0,
	func   => sub { _pg_current('timestamp',0) }
   },
   
   {
	name   => 'timeofday',
	argnum => 0,
	func   => sub { scalar localtime; }
   },

   # Sequence Manipulation Functions
   # http://www.postgresql.org/docs/current/static/functions-sequence.html
   {
	name   => 'nextval',
	argnum => 1,
	func   => sub { _nextval(@_) }
   },
   {
	name   => 'currval',
	argnum => 1,
	func   => sub { _currval(@_)  }
   },
   {
	name   => 'lastval',
	argnum => 0,
	func   => sub { _lastval()  }
   },
   {
	name   => 'setval',
	argnum => 2,
	func   => sub { _setval(@_) }
   },
   {
	name   => 'setval',
	argnum => 3,
	func   => sub { _setval(@_) }
   },

   # Misc Functions
   # http://www.postgresql.org/docs/current/static/functions-misc.html
   # Most of these are omitted.
   {
	name   => 'current_user',
	argnum => 0,
	func   => sub { (getpwuid $>)[0] }
   },
   {
	name   => 'session_user',
	argnum => 0,
	func   => sub { (getpwuid $>)[0] }
   },
   {
	name   => 'user',
	argnum => 0,
	func   => sub { (getpwuid $>)[0] }
   },
   
  );

# Transforms a stored procedure into a coderef
sub _sp_func {
	my $dbh = shift;
	my $name = shift;
	my $sql = shift;
	my $ret = sub {
		my @args = @_;
		die "No more than at most 9 arguments supported" if @args > 9;
		die "Non-SELECT statements not supported" unless $sql =~ /^\s*select\b/i;
		for (@args) {
			unless (defined $_) {
				$_ = 'NULL';
				next;
			}
			next if /^[\-\+]?\d+(?:\.\d+)$/;
			s/\'/\'\'/g;
			$_ = "'".$_."'";
		}
		if (@args && $sql =~ /\$\d/) {
			for my $i (1..9) { # supports only up to 9 args
				$sql =~ s/\$${i}/$args[$i-1]/g;
			}
		}
		my $res = $dbh->selectall_arrayref($sql);
		return undef unless $res && @$res;
		die "User-defined SQL function '$name' returns more than 1 row for values [ @_ ]" if @$res > 1;
		my $row = $res->[0];
		die "User-defined SQL function '$name' returns more than 1 column for values [ @_ ]" if @$row > 1;
		return $row->[0];
	};
	return $ret;
}

sub _register_builtin_functions {
	my $dbh = shift; # real sqlite handle
	for (@functions) {
		$dbh->func( $_->{name}, $_->{argnum}, $_->{func}, "create_function" );
	}
	$dbh->func( "avg", 1, 'DBD::PgLite::Aggregate::avg', "create_aggregate" );
}

sub _register_stored_functions {
	my $pglite_dbh = shift;
	my $real_dbh = $pglite_dbh->{D};
	my $check = $real_dbh->selectrow_array("select name from sqlite_master where type = 'table' and name = 'pglite_functions'");
	if ($check) {
		my $sproc = $real_dbh->selectall_arrayref("select name, argnum, type, sql from pglite_functions",{Columns=>{}});
		for my $sp (@$sproc) {
			if ($sp->{type} eq 'perl') {
				my $func = eval $sp->{sql};
				if ($@) {
					warn "WARNING: invalid stored perl function '$sp->{name}' - skipping ($@)\n";
				} else {
					$real_dbh->func( $sp->{name}, $sp->{argnum}, $func, "create_function" );
				}
			} else {