tcltk-feather sqlitedb.tcl package

Purpose:

Database connectivity package to establish a connection to a remote sqlite database file via http protocol and with the aid of the SqliteDB PHP interface.

Be aware that this package is a proove of concept and far from complete.

Scenario:

  • The sqlite databasefile is stored on a remote drive shared by your internet provider.

  • With the aid of sqlitedb.php and sqlitedb.tcl it is possible to get access to the sqlite database in a similar manner as when working within a local environment.

  • database connectivity is managed over the http protocol and with apache + mod_php plus PHP sqlite extension (which nowadays is the default for a modern apache/PHP stack).

  • A client program can be developed which stores it’s database on the www (or on the intranet)!

    Advantages:

    • ability to create web based client software, without the need of a browser, but with modern internet connectivity, whereas the client software interacts with a database (represented as an sqlite file) stored on a remote server,

    • rapid software development due to less dependencies,

    • let the administrator manage the database (with auto-backup, protection against deletion, etc…)

    • multi user friendly

Installation:

  • The sqlitedb.php file needs to be installed and configured correctly on the server (apache with mod_php and sqlite extension).

    In other words, the php file needs to be copied on a valid directory onto the web-space of the provider and confugured as usual via .htaccess, etc.

  • And yes, as we use sqlite, there is no explicit database server required.

Code:

  • pkgIndex.tcl

package ifneeded sqlitedb 0.1 \
	"[list source [file join $dir sqlitedb.tcl]];"
  • sqlitedb.tcl

# -----------------------------------------------------------------------------
# sqlitedb.tcl ---
# -----------------------------------------------------------------------------
# (c) 2018, Johann Oberdorfer - Engineering Support | CAD | Software
#     johann.oberdorfer [at] gmail.com
#     www.johann-oberdorfer.eu
# -----------------------------------------------------------------------------
# This source file is distributed under the BSD license.
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#   See the BSD License for more details.
# -----------------------------------------------------------------------------
# 
# Purpose:
#   Database connectivity package to establish a connection to a remote sqlite
#   database file via http protocol and with the aid of the SqliteDB PHP
#   interface.
#	The SqliteDB PHP code needs to be installed and configures correctly on
#   the server (apache with mod_php and sqlite extension).
#
#   This package is a proove of concept.
# -----------------------------------------------------------------------------
#
# Revision history:
# 18-12-06: Hans, V0.1 - Initial release
# -----------------------------------------------------------------------------


# set dir [file dirname [file normalize [info script]]]
# lappend auto_path [file join $dir "lib"]

package require http
package require json

package provide sqlitedb 0.1


namespace eval ::sqlitedb:: {

	# purpose of this function mainly is to stay compatible with the
	# rest of our existing code
	# note:
	#   json2dict returns a list of dicts
	#   this function converts to a "standard" data-list where the
	#   list only consinst of data items !
	#
	proc convert_dict2list {data} {
		set new_datalist [list]
		
		foreach item $data {
			set item_list [list]
			dict for {descr value} $item {
				lappend item_list $value
			}
			lappend new_datalist $item_list
		}

		return $new_datalist
	}

	# hand over the sql string to PHP interface code via "sql" argument
	#
	# this way it makes it very easy to move away complex logic from the
	# client application to the database server :=) ...
	#
	proc sqlEval {url sql} {
		::http::config -urlencoding "utf-8"

		puts \
"
>> $url
>> $sql
"		
		# ...instead of putting the data on the URL
		#    it's saver to put it in the body of a POST request:
		set body $sql

		# dict set hdr "Content-Type" "text/xml"
		
		# ...once we've got the headers and the data, we can send the POST like this:

		if { [catch {set handle [http::geturl $url -query $body]} errmsg] != 0 } {
		
			append errmsg "\n\nPlease make shure your computer has a"
			append errmsg "\nvalid internet connection and try again!"

			tk_messageBox \
				-title "Error with http connection:" \
				-message $errmsg
				-type ok -icon "error"

			return {}
		}

		set data [::http::data $handle]

		if { [string first "INSERT" [string toupper $sql]] != -1 ||
			 [string first "UPDATE" [string toupper $sql]] != -1 ||
			 [string first "DELETE" [string toupper $sql]] != -1 } {

			::http::cleanup $handle
			return [list $data]
		}

		# 1.) is there an error raised by the http layer?
		# {
		#	"error": {
        #	"code": 204,
        #	"status": "No Content"
		#	} 
		# }

		# dump the error message to stdout and we are done!
		if { [::http::ncode $handle] != 200 } {
			puts ">> Error occured: [::http::code $handle] - no data available."
			::http::cleanup $handle
			return {}
		}
		
		::http::cleanup $handle

		# json2dict returns a list of dicts:

		set jsondata [encoding convertfrom "utf-8" $data]
		set ddata [::json::json2dict $jsondata]
		
		# is there something going wrong with the returned data
		# from the sqlitedb index.php interface ?

		if { [lindex [lindex $ddata 0] 0] eq "error" } {
			puts ">> SQL statement does not return any data."
			return {}
		}

		# convert_dict2list might also raise an error,
		# going to test 1st, if it's required to use catch here...

		set ldata [convert_dict2list $ddata]
		puts ">> Data list contains: [llength $ldata] item(s)."
		
		return $ldata
	}

	proc is_valid_connection {url} {

		::http::config -urlencoding "utf-8"
		set query [::http::formatQuery "sql" "SELECT COUNT(*) FROM sqlite_master;"]
		append url "?${query}"
		
		if { [catch {set handle [::http::geturl $url]} errmsg] != 0 } {
			return 0
		}
		
		# error handling: maybe this is not working as expected,
		# missing database is created by the interface and ncode is still 200 !!!
		# so better check against data lenght > 0 ?
		# or something different (maybe improve error handling in foreign PHP code) ?...

		if { [::http::ncode $handle] != 200 } {
			return 0
		}

		set data [::http::data $handle]

		if { [string first "error" $data] != -1 } {
			return 0
		}

		# json2dict returns a list of dicts:
		set ddict [lindex [::json::json2dict $data] 0]

		if { [dict get $ddict "COUNT(*)"] == 0 } {
			return 0
		}
		
		::http::cleanup $handle
		return 1
	}


	# get the names of all the tables /views
	# obj. could either be "table" or "view"
	proc get_AllObjectNames {url {type "table"}} {
		
		set sql \
		"SELECT name FROM sqlite_master
		  WHERE type='$type'
		    AND name NOT LIKE 'sqlite_sequence'
		    AND name NOT LIKE '%_images'
		  UNION ALL SELECT name FROM sqlite_temp_master
		  WHERE type='$type'
		  ORDER BY name;"
		
		set object_names [sqlEval $url $sql]
		return $object_names
	}

	proc get_ColumnNames {url table_name} {
		set column_names [list]
		set data [sqlEval $url "PRAGMA table_info('$table_name');"]
		
		# json:
		# {
		#   {cid 0 name ID type INTEGER notnull 1 dflt_value null pk 1}
		#   {cid 1 name Photography type BOOLEAN notnull 0 dflt_value '' pk 0}
		#   ...
		# }
		# 	foreach item $data {
		#     dict for {descr value} $item {
		#       if {$descr eq "name"} {	lappend column_names $value }
		#	}}
        #
		# list:
		# {
		#   {0 ID INTEGER 1 null 1} 
		#   {1 Photography BOOLEAN 0 '' 0}
		#   ...
		# }

		foreach item $data {
			lappend column_names [lindex $item 1]
		}
		
		return $column_names
	}

	proc get_ColumnTypes {url table_name} {
		set column_types [list]
		set data [sqlEval $url "PRAGMA table_info('$table_name');"]
		
		foreach item $data {
			lappend column_types [lindex $item 2]
		}
		
		return $column_types
	}
	
	proc get_primarykey_index {url table_name} {
		set data [sqlEval $url "PRAGMA table_info('$table_name');"]
		
		set cnt -1
		# cid name type null def pkey
		foreach item $data {
			set name [lindex $item 1]
			set pkey  [lindex $item end]
		
			if {[string length $name] == 0} {
				continue
			}
			incr cnt
			if {$pkey == 1 } {
				return $cnt
			}
		}
		return -1
	}
	
	proc get_CreateStatement {url table_name} {

		set sql \
		"SELECT sql FROM
		(SELECT * FROM sqlite_master UNION ALL
		 SELECT * FROM sqlite_temp_master)
		  WHERE tbl_name LIKE '$table_name'
		    AND type != 'meta'
		  ORDER BY type DESC, name;"
	
		set data [lindex [lindex [sqlEval $url $sql] 0] 0]
		
		return $data
	}
}
  • sqlitedb.php

<?php

/**
* The MIT License
* http://creativecommons.org/licenses/MIT/
*
* SqliteDB 0.1 ---
* -------------------------------------------------------------------------
* (c) 2018, Johann Oberdorfer - Engineering Support | CAD | Software
*     johann.oberdorfer [at] gmail.com
*     www.johann-oberdorfer.eu
* -------------------------------------------------------------------------
* This source file is distributed under the MIT license.
*   This program is distributed in the hope that it will be useful,
*   but WITHOUT ANY WARRANTY; without even the implied warranty of
*   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*   See the BSD License for more details.
* -------------------------------------------------------------------------
* Credits:
*   Great thanks to Alix Axel for his ArrestDB PHP interface.
*   I used this code and basicly removed all code not related to sqlite,
*   keeping only the interface for interaction with the sqlite database (file).
*
*   The MIT License
*   http://creativecommons.org/licenses/MIT/
*
*   ArrestDB 1.9.0 (github.com/alixaxel/ArrestDB/)
*   Copyright (c) 2014 Alix Axel <alix.axel@gmail.com>
**/

// these are the only settings required to configure the interface:
//
// $dsn = 'sqlite://./db/my_database.db';
// $clients = [];

$sql = file_get_contents('php://input');

// debugging purpose only,
// if enabled, be aware that "echo" would confuse
// the json return data and therfore would cause tcl's json converterto fail
//
// echo "<p>Sql: " . $sql . "</p>";


if ((empty($clients) !== true) && (in_array($_SERVER['REMOTE_ADDR'], (array) $clients) !== true))
{
	exit(SqliteDB::Reply(SqliteDB::$HTTP[403]));
}

else if (SqliteDB::Query($dsn) === false)
{
	exit(SqliteDB::Reply(SqliteDB::$HTTP[503]));
}

class SqliteDB
{
	public static $HTTP = [
		200 => ['success' => ['code' => 200, 'status' => 'OK',         ],],
		201 => ['success' => ['code' => 201, 'status' => 'Created',    ],],
		204 => ['error'   => ['code' => 204, 'status' => 'No Content', ],],
		400 => ['error'   => ['code' => 400, 'status' => 'Bad Request',],],
		403 => ['error'   => ['code' => 403, 'status' => 'Forbidden',  ],],
		404 => ['error'   => ['code' => 404, 'status' => 'Not Found',  ],],
		409 => ['error'   => ['code' => 409, 'status' => 'Conflict',   ],],
		503 => ['error'   => ['code' => 503, 'status' => 'Service Unavailable',],],
	];

	public static function Query($query = null)
	{
		static $db = null;
		static $result = [];

		try
		{
			if (isset($db, $query) === true)
			{
				if (empty($result[$hash = crc32($query)]) === true)
				{
					$result[$hash] = $db->prepare($query);
				}

				$data = array_slice(func_get_args(), 1);

				if (count($data, COUNT_RECURSIVE) > count($data))
				{
					$data = iterator_to_array(new \RecursiveIteratorIterator(new \RecursiveArrayIterator($data)), false);
				}

				if ($result[$hash]->execute($data) === true)
				{
					$sequence = null;

					switch (strstr($query, ' ', true))
					{
						case 'INSERT':
						case 'REPLACE':
							return $db->lastInsertId($sequence);

						case 'UPDATE':
						case 'DELETE':
							return $result[$hash]->rowCount();

						case 'SELECT':
						case 'EXPLAIN':
						case 'PRAGMA':
						case 'SHOW':
							return $result[$hash]->fetchAll();
					}

					return true;
				}

				return false;
			}

			else if (isset($query) === true)
			{
				$options = array
				(
					\PDO::ATTR_CASE => \PDO::CASE_NATURAL,
					\PDO::ATTR_DEFAULT_FETCH_MODE => \PDO::FETCH_ASSOC,
					\PDO::ATTR_EMULATE_PREPARES => false,
					\PDO::ATTR_ERRMODE => \PDO::ERRMODE_EXCEPTION,
					\PDO::ATTR_ORACLE_NULLS => \PDO::NULL_NATURAL,
					\PDO::ATTR_STRINGIFY_FETCHES => false,
				);

				if (preg_match('~^sqlite://([[:print:]]++)$~i', $query, $dsn) > 0)
				{
					$options += array
					(
						\PDO::ATTR_TIMEOUT => 3,
					);

					$db = new \PDO(sprintf('sqlite:%s', $dsn[1]), null, null, $options);
					$pragmas = array
					(
						'automatic_index' => 'ON',
						'cache_size' => '8192',
						'foreign_keys' => 'ON',
						'journal_size_limit' => '67110000',
						'locking_mode' => 'NORMAL',
						'page_size' => '4096',
						'recursive_triggers' => 'ON',
						'secure_delete' => 'ON',
						'synchronous' => 'NORMAL',
						'temp_store' => 'MEMORY',
						'journal_mode' => 'WAL',
						'wal_autocheckpoint' => '4096',
					);

					if (strncasecmp(PHP_OS, 'WIN', 3) !== 0)
					{
						$memory = 131072;

						if (($page = intval(shell_exec('getconf PAGESIZE'))) > 0)
						{
							$pragmas['page_size'] = $page;
						}

						if (is_readable('/proc/meminfo') === true)
						{
							if (is_resource($handle = fopen('/proc/meminfo', 'rb')) === true)
							{
								while (($line = fgets($handle, 1024)) !== false)
								{
									if (sscanf($line, 'MemTotal: %d kB', $memory) == 1)
									{
										$memory = round($memory / 131072) * 131072; break;
									}
								}

								fclose($handle);
							}
						}

						$pragmas['cache_size'] = intval($memory * 0.25 / ($pragmas['page_size'] / 1024));
						$pragmas['wal_autocheckpoint'] = $pragmas['cache_size'] / 2;
					}

					foreach ($pragmas as $key => $value)
					{
						$db->exec(sprintf('PRAGMA %s=%s;', $key, $value));
					}
				}
			}
		}

		catch (\Exception $exception)
		{
			return false;
		}

		return (isset($db) === true) ? $db : false;
	}

	public static function Reply($data)
	{
		$bitmask = 0;
		$options = ['UNESCAPED_SLASHES', 'UNESCAPED_UNICODE'];

		if (empty($_SERVER['HTTP_X_REQUESTED_WITH']) === true)
		{
			$options[] = 'PRETTY_PRINT';
		}

		foreach ($options as $option)
		{
			$bitmask |= (defined('JSON_' . $option) === true) ? constant('JSON_' . $option) : 0;
		}

		if (($result = json_encode($data, $bitmask)) !== false)
		{
			$callback = null;

			if (array_key_exists('callback', $_GET) === true)
			{
				$callback = trim(preg_replace('~[^[:alnum:]\[\]_.]~', '', $_GET['callback']));

				if (empty($callback) !== true)
				{
					$result = sprintf('%s(%s);', $callback, $result);
				}
			}

			if (headers_sent() !== true)
			{
				header(sprintf('Content-Type: application/%s; charset=utf-8', (empty($callback) === true) ? 'json' : 'javascript'));
			}
		}

		return $result;
	}
}

$result = SqliteDB::Query($sql);

if ($result === false)
{
	$result = SqliteDB::$HTTP[404];
}
else if (empty($result) === true)
{
	$result = SqliteDB::$HTTP[204];
}

exit(SqliteDB::Reply($result));

?>
  • sqlitedb_test.tcl


set dir [file dirname [file normalize [info script]]]

# specify, where to find support packages:
lappend auto_path [file join $dir "../../lib"]
lappend auto_path [file join $dir "."]

package require http
package require json

package require sqlitedb


catch {
	console show
	console eval {wm protocol . WM_DELETE_WINDOW {exit 0}}
}

# PHP tutorial:
# http://computer-programming-forum.com/57-tcl/f2b80bf59ac4ac6c.htm


if {0} {

	# some arbitrary tests...

	# open the URL to get the results:

	::http::config -urlencoding "utf-8"

	set handle [::http::geturl "http://php.johann-oberdorfer.eu/index.php/IdeasAndNotes"]

	set body [::http::data $handle]
	puts \
"
------------------------------------------------
return content:
$body
------------------------------------------------
"
	set stat [::http::code $handle]
	puts \
"
------------------------------------------------
return code:
$stat
------------------------------------------------
"
	set headers [::http::meta $handle]
	puts \
"
------------------------------------------------
return headers:
"
	foreach {name value} $headers {
			puts "$name: $value"
	}

	set data [encoding convertfrom "utf-8" [::http::data $handle]]

	set data [::json::json2dict $data]
	# set data [::json::many-json2dict $data]

	foreach {name value} $data {
		puts "$name: $value"
	}

	::http::cleanup $handle
}


# -INTERFACE TEST-

# note:
#   the sqlite database name is already configured in the index.php file
#   whereas index.php **is** the sqlitedb PHP interface for sqlite

set url "http://php.johann-oberdorfer.eu/index.php/"


if {0} {

	puts [::sqlitedb::is_valid_connection $url]

	set sql "SELECT \"ID\", \"Photography\", \"Programming\", \"Misc\", \"Tag\", \"DESCRIPTION\", \"NOTES\", \"% DONE\"
			   FROM \"IdeasAndNotes\";"
	puts [::sqlitedb::sqlEval $url $sql]

	puts [::sqlitedb::sqlEval $url "SELECT COUNT(*) FROM sqlite_master;"] 
	puts [::sqlitedb::get_AllObjectNames $url]

	set table_names [::sqlitedb::get_AllObjectNames $url]
	set table_name [lindex $table_names 0]

	puts [::sqlitedb::get_ColumnNames $url $table_name]
	puts [::sqlitedb::get_ColumnTypes $url $table_name]
	puts [::sqlitedb::get_primarykey_index $url $table_name]
	puts [::sqlitedb::get_CreateStatement $url $table_name]
}


set table_names [::sqlitedb::get_AllObjectNames $url]

foreach name $table_names {
	puts "Table name: $name"
}

set table_name [lindex $table_names 0]

puts [::sqlitedb::get_ColumnNames $url $table_name]
puts [::sqlitedb::get_ColumnTypes $url $table_name]

Credits:

The sqlitedb.php package is derived from ArrestDB, which basicly interacts with the sqlite database on the remote server:

  • ArrestDB 1.9.0 (github.com/alixaxel/ArrestDB/) Copyright (c) 2014 Alix Axel

Project status:

This package for the moment is a proove of concept.

Based on this software, I developed some kind of a to-do or task-list manager which is capable to share information amongst a team of developers (multi-user application).