tcltk-logo 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 © 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).