96 lines
2.9 KiB
Racket
Executable File
96 lines
2.9 KiB
Racket
Executable File
#lang racket/base
|
|
|
|
(require db
|
|
racket/string
|
|
)
|
|
|
|
(provide read-all)
|
|
|
|
(define crm-cfg-file (build-path (find-system-path 'home-dir) "crm" "data" "config-internal.php"))
|
|
|
|
(define (read-db-config)
|
|
(let ((fh (open-input-file crm-cfg-file))
|
|
(host #f)
|
|
(port #f)
|
|
(user #f)
|
|
(passwd #f)
|
|
(dbname #f)
|
|
(re-key-val #px"[']([a-z]+)[']\\s*[=][>]\\s*[']([^']*)[']")
|
|
)
|
|
(let loop ()
|
|
(let* ((line (read-line fh))
|
|
(m (if (eof-object? line) #f (regexp-match re-key-val line)))
|
|
)
|
|
(cond
|
|
((eof-object? line)
|
|
(close-input-port fh)
|
|
(list host port user passwd dbname))
|
|
((not (eq? m #f))
|
|
(let ((key (cadr m))
|
|
(val (caddr m)))
|
|
(cond
|
|
((string=? key "host") (set! host val))
|
|
((string=? key "port") (set! port (if (string=? val "") 3306 (string->number val))))
|
|
((string=? key "dbname") (set! dbname val))
|
|
((string=? key "user") (set! user val))
|
|
((string=? key "password") (set! passwd val))
|
|
)
|
|
(loop)
|
|
))
|
|
(else (loop))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
(define (connect-db host port user passwd dbname)
|
|
(let ((dbh (mysql-connect #:user user #:database dbname
|
|
#:port port #:server host
|
|
#:password passwd)))
|
|
dbh))
|
|
|
|
|
|
(define (to-file name content)
|
|
(let ((fh (open-output-file name #:exists 'replace)))
|
|
(display content fh)
|
|
(close-output-port fh)
|
|
))
|
|
|
|
(define (handle-rows dir rows)
|
|
(for-each
|
|
(lambda (row)
|
|
(let* ((id (vector-ref row 0))
|
|
(name (vector-ref row 1))
|
|
(description (vector-ref row 2))
|
|
(value_script (vector-ref row 3))
|
|
(re #px"[/><]")
|
|
(mk-name (lambda (name ext) (build-path dir
|
|
(string-append
|
|
(regexp-replace* name re "_") "." ext))))
|
|
)
|
|
|
|
(displayln (format "making ~a / ~a" dir name))
|
|
(to-file (mk-name name "id") id)
|
|
(to-file (mk-name name "name") name)
|
|
(to-file (mk-name name "js") value_script)
|
|
(to-file (mk-name name "descr") description)
|
|
))
|
|
rows))
|
|
|
|
(define (read-script-configs dbh)
|
|
(let ((rows (query-rows dbh "select id, name, description, value_script from config where type = 'script' and deleted = 0")))
|
|
(handle-rows "configs" rows)))
|
|
|
|
(define (read-scripts dbh)
|
|
(let ((rows (query-rows dbh "select id, name, description, formule from script where deleted = 0")))
|
|
(handle-rows "scripts" rows)))
|
|
|
|
(define (read-all)
|
|
(let ((dbh (apply connect-db (read-db-config))))
|
|
(read-script-configs dbh)
|
|
(read-scripts dbh))
|
|
)
|
|
|