Overview
Comment:Basic twiki now working but still buggy
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 1a58be07460fd00d3891f7967f83a91fbca00421
User & Date: matt on 2012-08-04 20:55:09
Other Links: manifest | tags
Context
2012-08-08
15:06
Added direct access to pg conn check-in: 57f91bc5c8 user: matt tags: trunk
2012-08-04
20:55
Basic twiki now working but still buggy check-in: 1a58be0746 user: matt tags: trunk
18:56
Improved message for broken stml check-in: 8f51206e58 user: matt tags: trunk
Changes

Modified modules/twiki/twiki-mod.scm from [1e45e35279] to [d4d21ad337].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
;; Copyright 2007-2010, Matthew Welland.
;;
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;;
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

;; twiki module
(require-extension sqlite3 regex posix md5 base64)
(import (prefix base64 base64:))

;; TODO
;;
;; * Inline tiddlers [inline[TiddlerName]]
;; * Pics            [pic X Y[picname.jpg]]
;; * Move twiki parsing/expanding to mattsutils as loadable module










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
;; Copyright 2007-2010, Matthew Welland.
;;
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;;
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

;; twiki module
(require-extension sqlite3 regex posix md5 message-digest base64)
(import (prefix base64 base64:))

;; TODO
;;
;; * Inline tiddlers [inline[TiddlerName]]
;; * Pics            [pic X Y[picname.jpg]]
;; * Move twiki parsing/expanding to mattsutils as loadable module
34
35
36
37
38
39
40
41



42
43
44
45
46
47
48
49
50


51
52
53
54
55
56
57
58
59
(define (twiki:open-db key . create-not-ok)
  ;; (s:log "Got to twiki:open-db with key: " key)
  (let* ((create-ok (if (null? create-not-ok) #t (car create-not-ok)))
	 (fdat      (twiki:key->fname key))
	 (basepath  (sdat-get-twikidir s:session))
	 (fpath     (car fdat))
	 (fname     (cadr fdat))
	 (fullname  (conc basepath "/" fpath "/" fname))



	 (fexists   (file-exists? fullname))
	 (db        (if fexists (dbi:open 'sqlite3 (list (cons 'dbname fullname))) #f)))
    (if (and (not db)
	     (not create-ok))
	(exit 100)
	(begin
	  (if (not fexists)
	      (begin
		;; (print "fullname: " fullname)


		(twiki:register-wiki key fullname)
		(system (conc "mkdir -p " fpath)) ;; create the path
		(if (file-exists? fpath)
		    (s:log "OK: dir " fpath " has been made")
		    (s:log "ERROR: Failed to make the path for the twiki"))
		(set! db (dbi:open 'sqlite3 (list (cons 'dbname fullname))))
		(for-each 
		 (lambda (sqry)
		   ;; (print sqry)







|
>
>
>









>
>

|







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
(define (twiki:open-db key . create-not-ok)
  ;; (s:log "Got to twiki:open-db with key: " key)
  (let* ((create-ok (if (null? create-not-ok) #t (car create-not-ok)))
	 (fdat      (twiki:key->fname key))
	 (basepath  (sdat-get-twikidir s:session))
	 (fpath     (car fdat))
	 (fname     (cadr fdat))
	 (fulldir   (conc basepath "/" fpath))
	 (fullname  (let ((fn (conc fulldir "/" fname)))
		      (if (sdat-get-debugmode s:session)(s:log "\ntwikipath: " fn))
		      fn))
	 (fexists   (file-exists? fullname))
	 (db        (if fexists (dbi:open 'sqlite3 (list (cons 'dbname fullname))) #f)))
    (if (and (not db)
	     (not create-ok))
	(exit 100)
	(begin
	  (if (not fexists)
	      (begin
		;; (print "fullname: " fullname)
		(if (sdat-get-debugmode s:session)
		    (s:log "\ncreating fulldir: " fulldir))
		(twiki:register-wiki key fullname)
		(system (conc "mkdir -p " fulldir)) ;; create the path
		(if (file-exists? fpath)
		    (s:log "OK: dir " fpath " has been made")
		    (s:log "ERROR: Failed to make the path for the twiki"))
		(set! db (dbi:open 'sqlite3 (list (cons 'dbname fullname))))
		(for-each 
		 (lambda (sqry)
		   ;; (print sqry)
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
(define (twiki:key->fname key)
  (let* (;; (md5keypath (md5:digest key)) ;; (twiki:keys->key keys)))
	 (keypath    (twiki:web64enc key))
	 (delta      (quotient (string-length keypath) 3)) ;; 
	 (p1         (substring keypath 0           delta)) ;;  0  8))
	 (p2         (substring keypath delta       (* delta 2)));;  8 16))
	 (p3         (substring keypath (* delta 2) (* delta 3)))) ;; 16 24))
    (list (string-intersperse (list "twikis" p1 p2 p3) "/") keypath)))

;; look up the wid based on the keys, this is used for sub wikis only. I.e. a wiki instantiated inside another wiki 
;; giving a separate namespace to all the tiddlers
(define (twiki:name->wid db name) 
  (let ((wid (dbi:get-one db "SELECT id FROM wikis WHERE name=?;" name)))
    (if wid wid
	(begin







|







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
(define (twiki:key->fname key)
  (let* (;; (md5keypath (md5:digest key)) ;; (twiki:keys->key keys)))
	 (keypath    (twiki:web64enc key))
	 (delta      (quotient (string-length keypath) 3)) ;; 
	 (p1         (substring keypath 0           delta)) ;;  0  8))
	 (p2         (substring keypath delta       (* delta 2)));;  8 16))
	 (p3         (substring keypath (* delta 2) (* delta 3)))) ;; 16 24))
    (list (string-intersperse (list "dbs" p1 p2 p3) "/") keypath)))

;; look up the wid based on the keys, this is used for sub wikis only. I.e. a wiki instantiated inside another wiki 
;; giving a separate namespace to all the tiddlers
(define (twiki:name->wid db name) 
  (let ((wid (dbi:get-one db "SELECT id FROM wikis WHERE name=?;" name)))
    (if wid wid
	(begin
175
176
177
178
179
180
181
182
183
184



185
186
187
188
189
190
191
192
;;======================================================================
;; twiki registry
;;======================================================================

;; these can be overridden by end user (just create a new routine by the same name)

(define (twiki:open-registry)
  (let* ((basepath  (sdat-get-sroot s:session))
	 (regfile   (conc basepath "/twikis/registry.db"))
	 (regexists (file-exists? regfile))



	 (db        (dbi:open 'sqlite3 (list (cons 'dbname regfile)))))
    (if regexists
	db
	(begin
	  (for-each (lambda (stmt)(dbi:exec db stmt))
		    (list "CREATE TABLE wikis (key TEXT PRIMARY KEY,path TEXT,creation_date INTEGER,creator_id INTEGER);"))
	  db))))








|
|

>
>
>
|







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
;;======================================================================
;; twiki registry
;;======================================================================

;; these can be overridden by end user (just create a new routine by the same name)

(define (twiki:open-registry)
  (let* ((basepath  (sdat-get-twikidir s:session))
	 (regfile   (conc basepath "/registry.db"))
	 (regexists (file-exists? regfile))
	 (db        #f))
    (if (sdat-get-debugmode s:session)
	(s:log "regfile: " regfile " regexists: " regexists " db: " db))
    (set! db (dbi:open 'sqlite3 (list (cons 'dbname regfile))))
    (if regexists
	db
	(begin
	  (for-each (lambda (stmt)(dbi:exec db stmt))
		    (list "CREATE TABLE wikis (key TEXT PRIMARY KEY,path TEXT,creation_date INTEGER,creator_id INTEGER);"))
	  db))))

351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
			"INSERT INTO tiddlers (wiki_id,name,dat_id,created_on,owner_id) VALUES(?,?,?,?,?);"
			wid heading dat-id (current-seconds) uid))
	  #t) ;; success
	#f))  ;; non-success

;; text=0, jpg=1, png=2
(define (twiki:save-dat db dat type)
  (let* ((md5sum (md5-digest dat))
	 (datid  (twiki:dat-exists? db md5sum type))
	 (datblob (if (string? dat)
		      (string->blob dat)
		      dat)))
    (if datid
	datid
	(begin







|







359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
			"INSERT INTO tiddlers (wiki_id,name,dat_id,created_on,owner_id) VALUES(?,?,?,?,?);"
			wid heading dat-id (current-seconds) uid))
	  #t) ;; success
	#f))  ;; non-success

;; text=0, jpg=1, png=2
(define (twiki:save-dat db dat type)
  (let* ((md5sum (message-digest-string (md5-primitive) dat)) ;; (md5-digest dat))
	 (datid  (twiki:dat-exists? db md5sum type))
	 (datblob (if (string? dat)
		      (string->blob dat)
		      dat)))
    (if datid
	datid
	(begin

Modified session.scm from [bc08001dad] to [5ace07e7c5].

162
163
164
165
166
167
168
169

170
171
172
173
174
175

176
177
178
179
180
181
182
	 (configdat (if rawconfigdat (eval rawconfigdat) '()))
	 (sroot     (s:find-param 'sroot    configdat))
	 (logfile   (s:find-param 'logfile  configdat))
	 (dbtype    (s:find-param 'dbtype   configdat))
	 (dbinit    (s:find-param 'dbinit   configdat))
	 (domain    (s:find-param 'domain   configdat))
	 (twikidir  (s:find-param 'twikidir configdat))
	 (page-dir  (s:find-param 'page-dir-style configdat)))

    (if sroot    (sdat-set-sroot!    self sroot))
    (if logfile  (sdat-set-logfile!  self logfile))
    (if dbtype   (sdat-set-dbtype!   self dbtype))
    (if dbinit   (sdat-set-dbinit!   self dbinit))
    (if domain   (sdat-set-domain!   self domain))
    (if twikidir (sdat-set-twikidir! self twikidir))

    (sdat-set-page-dir-style! self page-dir)
    ;; (print "configdat: ")(pp configdat)
    ;;(session:log self "sroot: " sroot " logfile: " logfile " dbtype: " dbtype 
    ;;		 " dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir)
    )
  )
;;   (let ((dbtype (sdat-get-dbtype self)))







|
>






>







162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
	 (configdat (if rawconfigdat (eval rawconfigdat) '()))
	 (sroot     (s:find-param 'sroot    configdat))
	 (logfile   (s:find-param 'logfile  configdat))
	 (dbtype    (s:find-param 'dbtype   configdat))
	 (dbinit    (s:find-param 'dbinit   configdat))
	 (domain    (s:find-param 'domain   configdat))
	 (twikidir  (s:find-param 'twikidir configdat))
	 (page-dir  (s:find-param 'page-dir-style configdat))
	 (debugmode (s:find-param 'debugmode configdat)))
    (if sroot    (sdat-set-sroot!    self sroot))
    (if logfile  (sdat-set-logfile!  self logfile))
    (if dbtype   (sdat-set-dbtype!   self dbtype))
    (if dbinit   (sdat-set-dbinit!   self dbinit))
    (if domain   (sdat-set-domain!   self domain))
    (if twikidir (sdat-set-twikidir! self twikidir))
    (if debugmode (sdat-set-debugmode! self debugmode))
    (sdat-set-page-dir-style! self page-dir)
    ;; (print "configdat: ")(pp configdat)
    ;;(session:log self "sroot: " sroot " logfile: " logfile " dbtype: " dbtype 
    ;;		 " dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir)
    )
  )
;;   (let ((dbtype (sdat-get-dbtype self)))