- Disable interpreted usage, it doesn't seem to work.
- Move comments outside of functions, I miss docstrings...
- Move handling of "other" arguments to separate function.
This commit is contained in:
Tom Willemsen 2013-02-02 15:03:09 +01:00
parent e0cb224854
commit 1d51bacd51

View file

@ -23,66 +23,66 @@
(declare (uses paths (declare (uses paths
common)) common))
#+chicken-script
(begin
(load "paths")
(load "common"))
(require-extension sqlite3) (require-extension sqlite3)
(require-library posix srfi-4) (require-library posix srfi-4)
(define version "0.1.0") (define version "0.1.0")
(: string-no-null (string -> string))
(define (string-no-null str)
;; If STR contains a \0 byte at the end, remove it, otherwise return ;; If STR contains a \0 byte at the end, remove it, otherwise return
;; STR unchanged. ;; STR unchanged.
(: string-no-null (string -> string))
(define (string-no-null str)
(if (and (> (string-length str) 0) (if (and (> (string-length str) 0)
(char=? (string-ref str (- (string-length str) 1)) #\nul)) (char=? (string-ref str (- (string-length str) 1)) #\nul))
(substring str 0 (- (string-length str) 1)) (substring str 0 (- (string-length str) 1))
str)) str))
(: print-row (string fixnum string string -> void))
(define (print-row url seconds name description)
;; Print URL, SECONDS, NAME and DESCRIPTION to the standard output ;; Print URL, SECONDS, NAME and DESCRIPTION to the standard output
;; stream. ;; stream.
(format #t "~a~% ~a~% ~a~% ~a~%~%" (string-no-null name) (string-no-null description) (: print-row (string fixnum string string -> void))
(string-no-null url) (seconds->string seconds))) (define (print-row url seconds name description)
(format #t "~a~% ~a~% ~a~% ~a~%~%" (string-no-null name)
(string-no-null description) (string-no-null url)
(seconds->string seconds)))
(define (add-tag db name)
;; Add NAME to the `tag' table in DB. ;; Add NAME to the `tag' table in DB.
(define (add-tag db name)
(execute db "INSERT INTO tag VALUES (?)" name) (execute db "INSERT INTO tag VALUES (?)" name)
(last-insert-rowid db)) (last-insert-rowid db))
;; Add a bookmark to the `bookmark' table in DB. URL is the url of the
;; bookmark, NAME the title, DESCRIPTION a (possibly longer)
;; description of the bookmark and TAGS is a list of tags to assign to
;; it. Each tag will be created if necessary.
(define (add-bookmark db url name description tags) (define (add-bookmark db url name description tags)
;; Add a bookmark to the `bookmark' table in DB. URL is the url of
;; the bookmark, NAME the title, DESCRIPTION a (possibly longer)
;; description of the bookmark and TAGS is a list of tags to assign
;; to it. Each tag will be created if necessary.
(execute db "INSERT INTO bookmark VALUES (?, STRFTIME('%s'), ?, ?)" (execute db "INSERT INTO bookmark VALUES (?, STRFTIME('%s'), ?, ?)"
url name description) url name description)
(let ((bookmark-id (last-insert-rowid db))) (let ((bookmark-id (last-insert-rowid db)))
(for-each (lambda (tag) (for-each (lambda (tag)
(let ((tag-id '())) (let ((tag-id '()))
(condition-case (condition-case
(set! tag-id (first-result db "SELECT rowid FROM tag WHERE name = ?" tag)) (set! tag-id
(first-result
db "SELECT rowid FROM tag WHERE name = ?" tag))
(exn (exn sqlite3) (exn (exn sqlite3)
(if (eq? (get-condition-property exn 'sqlite3 'status) 'done) (if (eq? (get-condition-property
exn 'sqlite3 'status) 'done)
(set! tag-id (add-tag db tag)) (set! tag-id (add-tag db tag))
(signal exn)))) (signal exn))))
(execute db "INSERT INTO bookmark_tag VALUES (?, ?)" (execute db "INSERT INTO bookmark_tag VALUES (?, ?)"
bookmark-id tag-id))) bookmark-id tag-id)))
tags))) tags)))
(define (url-string? str)
;; Is STR a URL? Very naïve, assumes all URLs begin with either ;; Is STR a URL? Very naïve, assumes all URLs begin with either
;; `http://' or `https://', should be improved. ;; `http://' or `https://', should be improved.
(define (url-string? str)
(and (> (string-length str) 7) (and (> (string-length str) 7)
(or (string= (substring str 0 7) "http://") (or (string= (substring str 0 7) "http://")
(string= (substring str 0 8) "https://")))) (string= (substring str 0 8) "https://"))))
(define (display-help)
;; Display markam's help message. ;; Display markam's help message.
(define (display-help)
(format #t (string-append (format #t (string-append
"Usage: markam [options]...~%" "Usage: markam [options]...~%"
" markam <url> <name> <description> [<tag>...]~%" " markam <url> <name> <description> [<tag>...]~%"
@ -92,17 +92,8 @@
"--help, -h Display this help and exit~%" "--help, -h Display this help and exit~%"
"--version, -v Output version information and exit~%"))) "--version, -v Output version information and exit~%")))
(define (main args) ;; Parse command-line arguments
;; Open a database connection, do what the user asked and close it (define (handle-regular-args args)
;; again.
(let ((db (open-database (data-file "markam.db"))))
(if (null? args)
(for-each-row print-row db "select * from bookmark")
(if (url-string? (car args))
(with-transaction
db (lambda () (add-bookmark db (car args) (cadr args) (caddr args) (cdddr args)) #t))
;; If the first argument is not a URL, loop through all
;; arguments and proceed accordingly.
(do ((arg (car args) (and (not (null? args)) (do ((arg (car args) (and (not (null? args))
(car args)))) (car args))))
((or (null? arg) (not arg))) ((or (null? arg) (not arg)))
@ -115,7 +106,22 @@
(exit 0)) (exit 0))
(else (else
(format #t "Unrecognized option: ~a~%" (car args)))) (format #t "Unrecognized option: ~a~%" (car args))))
(set! args (cdr args))))) (set! args (cdr args))))
;; Open a database connection, list bookmarks, create a bookmark or
;; pass arguments on to `handle-regular-args'.
(define (main args)
(let ((db (open-database (data-file "markam.db"))))
(cond
((null? args)
(for-each-row print-row db "select * from bookmark"))
((url-string? (car args))
(with-transaction
db (lambda ()
(add-bookmark
db (car args) (cadr args) (caddr args) (cdddr args)) #t)))
(else
(handle-regular-args args)))
(finalize! db #t))) (finalize! db #t)))
(main (command-line-arguments)) (main (command-line-arguments))