83 lines
3.1 KiB
Racket
83 lines
3.1 KiB
Racket
#lang racket/base
|
|
(require racket/file
|
|
racket/list
|
|
racket/path
|
|
racket/string
|
|
json
|
|
json-pointer
|
|
db
|
|
"../lib/syntax.rkt")
|
|
|
|
(provide
|
|
get-slc
|
|
query-exec*
|
|
query-rows*
|
|
query-list*
|
|
query-value*
|
|
query-maybe-value*
|
|
query-maybe-row*)
|
|
|
|
(define storage-path (anytime-path ".." "storage"))
|
|
(define database-file (build-path storage-path "archiver.db"))
|
|
|
|
(define slc (box #f))
|
|
(define (get-slc)
|
|
(define slc* (unbox slc))
|
|
(cond
|
|
[slc* slc*]
|
|
[else
|
|
(make-directory* storage-path)
|
|
(define slc* (sqlite3-connect #:database database-file #:mode 'create))
|
|
(query-exec slc* "PRAGMA journal_mode=WAL")
|
|
(define database-version
|
|
(with-handlers ([exn:fail:sql?
|
|
(λ (exn)
|
|
; need to set up the database
|
|
(query-exec slc* "create table database_version (version integer, primary key (version))")
|
|
(query-exec slc* "insert into database_version values (0)")
|
|
0)])
|
|
(query-value slc* "select version from database_version")))
|
|
|
|
(define migrations
|
|
(wrap-sql
|
|
((query-exec slc* "create table page (wikiname TEXT NOT NULL, basename TEXT NOT NULL, progress INTEGER NOT NULL, PRIMARY KEY (wikiname, basename))")
|
|
(query-exec slc* "create table wiki (wikiname TEXT NOT NULL, progress INTEGER, PRIMARY KEY (wikiname))"))
|
|
((query-exec slc* "create table special_page (wikiname TEXT NOT NULL, key TEXT NOT NULL, basename TEXT NOT NULL, PRIMARY KEY (wikiname, key))"))
|
|
((query-exec slc* "update wiki set progress = 2 where wikiname in (select wikiname from wiki inner join page using (wikiname) group by wikiname having min(page.progress) = 1)"))
|
|
((query-exec slc* "create table image (wikiname TEXT NOT NULL, hash TEXT NTO NULL, url TEXT NOT NULL, ext TEXT, source INTEGER NOT NULL, progress INTEGER NOT NULL, PRIMARY KEY (wikiname, hash))"))
|
|
((query-exec slc* "alter table wiki add column sitename TEXT")
|
|
(query-exec slc* "alter table wiki add column basepage TEXT")
|
|
(query-exec slc* "alter table wiki add column license_text TEXT")
|
|
(query-exec slc* "alter table wiki add column license_url TEXT"))
|
|
((query-exec slc* "alter table page add column redirect"))))
|
|
|
|
(let do-migrate-step ()
|
|
(when (database-version . < . (length migrations))
|
|
(call-with-transaction
|
|
slc*
|
|
(list-ref migrations database-version))
|
|
(set! database-version (add1 database-version))
|
|
(query-exec slc* "update database_version set version = $1" database-version)
|
|
(do-migrate-step)))
|
|
|
|
(set-box! slc slc*)
|
|
slc*]))
|
|
|
|
(define (query-exec* . args)
|
|
(apply query-exec (get-slc) args))
|
|
|
|
(define (query-rows* . args)
|
|
(apply query-rows (get-slc) args))
|
|
|
|
(define (query-list* . args)
|
|
(apply query-list (get-slc) args))
|
|
|
|
(define (query-value* . args)
|
|
(apply query-value (get-slc) args))
|
|
|
|
(define (query-maybe-value* . args)
|
|
(apply query-maybe-value (get-slc) args))
|
|
|
|
(define (query-maybe-row* . args)
|
|
(apply query-maybe-row (get-slc) args))
|