Artifact f0bfeea040c63df8b42f83f68596310533ecf247:

• File packages/struct/lib/map/sqlite/compressed.tcl — part of check-in [c47a5ff0ea] at 2019-01-17 12:07:09 on branch trunk — gryp separate tree from session

  math fix small error.

  struct tree

  new package

  (user: pooryorick size: 3167)

#! /usr/bin/tclsh


package require sqlite3

namespace eval doc {}

proc .id _ {
	variable magicb
	$_ db onecolumn {select v from system where e = 0 and  a = @magicb}
}
.my .method .id


proc .init {_ args} {
	variable magicb
	$_ .vars path
	dict size $args
	set create 0
	foreach {opt val} $args {
		switch $opt {
			create {
				set create [expr {!!$val}]
			}
			path - id {
				set $opt $val
			}
			default {
				error [list {unknown option} $opt]
			}
		}
	}
	file mkdir [file dirname $path]
	sqlite3 [$_ .namespace]::db $path
	$_ .eval [list $_ .routine db]

	$_ db eval {
		PRAGMA journal_mode=WAL;
		-- PRAGMA main.synchronous=OFF;
	}
	if {![$_ db exists {select * from sqlite_master}]} {
		if {$create} {
			$_ db eval {
				create table system (
					rowid integer primary key 
					, e ,a ,v
				)

				-- use autoincrement to preserve information about insertion
				-- order
				; create table map ( 
					rowid integer primary key autoincrement
					, key unique
					, value
				)

				; insert into system values (null, 0 ,@magicb , @id)
			}
		} else {
			error [list {not a sqlite_compressed file} $path]
		}

	}
	if {![$_ db exists {select * from system where e = 0 and a = @magicb}]} {
		error [list {not a sqlite_compressed file} $path]
	}
	return $_
}
.my .method .init


proc exists {_ key} {
	set res [$_ db exists {
		select value from map where key = $key
	}]
	return $res
}
.my .method exists


proc missing {_ keys} {
	set res {}
	$_ db transaction {
		foreach key $keys {
			if {![$_ exists $key]} {
				lappend res $key
			}
		}
	}
	return $res
}
.my .method missing


proc get {_ key} {
	set qres [$_ db eval {
		select value from map where key = $key
	} {
		return [zlib decompress $value]
	}]
	error [list {no such item}]
}
.my .method get


proc keys {_ cmdname}  {
	set coro [uplevel 1 [list ::coroutine $cmdname $_ keys_coro [
		info coroutine]]]
	return $coro
}
.my .method keys


proc keys_coro {_ caller} {
	yield [info coroutine]
	$_ db eval {
		select key from map
	} {
		lassign [yieldto {*}$caller $key] caller
	}
	rename [info coroutine] {}
	puts [list returning break]
	yieldto {*}$caller -code break
}
.my .method keys_coro



variable doc::set {
	description
		returns true if a new value was stored and false if the value already
		existed.
}
proc set_ {_ key value} {
	set compressed [zlib compress $value 9]
	$_ db eval {
		insert or ignore into map values (null ,@key ,@compressed)
	}
	return [$_ db changes]
}
.my .method set set_


proc setbatch {_ list} {
	set stored 0
	set existing 0
	$_ db transaction {
		foreach {key value} $list {
			set compressed [zlib compress $value 9]
			try {
				$_ db eval {
					insert or ignore into map values (null ,@key ,@compressed)
				}
			} on error {tres topts} {
				puts [dict get $topts -errorinfo]
				return -options $topts $tres
			}
			if {[$_ db changes]} {
				incr stored
			} else {
				incr existing
			}
		}
	}
	return [list $stored $existing]
}
.my .method setbatch


proc .type _ {
	variable magicb
	return $mmagicb
}
.my .method .type


variable magic aa57eb0494925ba0dfd87d53c2ea5cf542874cad59df9a80ab62f50baf5b81bb
set magicb [binary format H* $magic]