(module yppdb mzscheme
(require (lib "unitsig.ss")
(lib "servlet-sig.ss" "web-server")
(lib "url.ss" "net")
(lib "servlet.ss" "web-server")
(lib "class.ss")
(lib "list.ss"))
(require "yppdb-util.ss"
(prefix sql-oo: (planet "sql-oo.ss" ("jaymccarthy" "sql-oo.plt" 1)))
(prefix sql-oo:paper: "sql-oo-paper.ss"))
(provide interface-version timeout generate-start)
(define interface-version 'v1)
(define timeout (* 60 60 24 5))
(define db:moc% (sql-oo:apply-units sql-oo:sql-oo%
sql-oo:paper:paper@))
(define FILTERS `())
(define BASE-URL "/servlet/not-yppdb.ss")
(define db:moc #f)
(define (template . body)
`(html (head (title "Your Personal Paper Database")
(style ([type "text/css"])
"div#banner { text-align: center; }
div#header { text-align: center; }
div#header ul li {
padding-left: 10px;
padding-right: 10px;
display: inline;
}
div#search {
text-align: center;
float: right;
width: 20%;
}
div#filter {
float: right;
clear: right;
width: 24%;
}
div#body {
float: left;
width: 74%;
}
div#body a {
text-decoration: none;
}
div#body a:hover {
text-decoration: underline;
}
div#footer {
float: right;
clear: right;
width: 100%;
}
a {
color: blue;
}
a.k-url:visited {
color: blue;
}
span.unread {
font-style: italic;
}"))
(body
(div ([id "banner"])
(h2 "Your Personal Paper Database"))
(div ([id "header"])
(div ([id "search"])
(form ([method "POST"]
[action ,(lambda (request)
(let ([the-bindings (request-bindings request)])
(with-binding the-bindings (field-name value)
(list-papers (sql-oo:paper:papers/search db:moc field-name value)))))])
(select ([name "field-name"])
,@(map
(lambda (f)
`(option ([value ,(car f)]) ,(cadr f)))
`( ("author" "Author")
("title" "Title")
("year" "Year")
("notes" "Notes") )))
nbsp
(input ([type "text"] [name "value"] [size "10"] [value ""]))
(br)
(input ([type "submit"] [value "Search"]))))
(ul
(li (a ([class "k-url"]
[href ,BASE-URL]) "Home"))
(li (a ([class "k-url"]
[href ,(lambda (request)
(list-papers/filters))])
"List"))
(li (a ([class "k-url"]
[href ,(lambda (request)
(edit-paper #f))])
"Add"))
(li (a ([class "k-url"]
[href ,(string-append "javascript:location.href='"
BASE-URL
"?bookmarklet=addPaper"
"&title='+encodeURIComponent(document.title)+'"
"&url='+encodeURIComponent(location.href)+'"
"'"
)])
"Post to YPPDB") " (Bookmarklet)")))
(div ([id "filter"])
(ul
(li (a ([class "k-url"]
[href ,(lambda (request)
(fluid-let ([FILTERS `()])
(list-papers/filters)))])
"Clear All Filters")))
(ul
,@(map
(lambda (category)
(if (member category FILTERS)
`(li (strong (a ([class "k-url"]
[href ,(lambda (request)
(fluid-let ([FILTERS (filter (lambda (c) (not (eq? category c))) FILTERS)])
(list-papers/filters)))])
,(symbol->string category))))
`(li (a ([class "k-url"]
[href ,(lambda (request)
(fluid-let ([FILTERS (append FILTERS (list category))])
(list-papers/filters)))])
,(symbol->string category)))))
(sql-oo:paper:category-list db:moc))))
(div ([id "body"])
,@body)
(div ([id "footer"])
(p ([align "right"])
"Powered by " (a ([href "http://www.plt-scheme.org/"])
(img ([width "53"] [height "19"] [src "/Defaults/documentation/plt-logo.gif"])))
(br)
(font ([size "2"]) "For more information on PLT Software, please follow the icon link."))))))
(define (list-papers paper-list)
(send/suspend/callback
(template
`(ul
,@(map
(lambda (paper)
(let ([paper-line (string-append (send paper title) " (" (send paper year) ") - " (send paper author))])
`(li (a ([href ,(send paper url)])
(span ([class ,(if (send paper read) "read" "unread")]) ,paper-line))
nbsp
(a ([class "k-url"]
[href ,(lambda (request)
(edit-paper paper))]) "#"))))
paper-list)))))
(define (list-papers/filters)
(list-papers (sql-oo:paper:papers/categories db:moc FILTERS)))
(define (edit-paper/apply the-paper return-to-edit? request)
(let ([the-bindings (request-bindings request)])
(with-bindings/defaults the-bindings
(read) ((title "") (author "") (year "") (url "") (categories "()") (notes "")) ()
(let ([paper (if the-paper
the-paper
(send db:moc object url "object_paper"))])
(send* paper
(title! title) (author! author) (year! year)
(url! url) (categories! categories) (read! read)
(notes! notes))
(if return-to-edit?
(edit-paper paper)
(list-papers/filters))))))
(define (edit-paper the-paper)
(let ([title (if the-paper (send the-paper title) "")]
[author (if the-paper (send the-paper author) "")]
[year (if the-paper (send the-paper year) "")]
[categories (if the-paper (send the-paper categories) "")]
[url (if the-paper (send the-paper url) "")]
[read (if the-paper (send the-paper read) #f)]
[notes (if the-paper (send the-paper notes) "")])
(send/suspend/callback
(template
`(form ([method "POST"]
[action ,(lambda (request)
(edit-paper/apply the-paper #f request))])
(table
(tr (td "Title:") (td (input ([type "text"] [size "83"] [name "title"] [value ,title]))))
(tr (td "Author:") (td (input ([type "text"] [size "83"] [name "author"] [value ,author]))))
(tr (td "Year:") (td (input ([type "text"] [name "year"] [value ,year]))))
(tr (td "Categories:") (td (input ([type "text"] [size "83"] [name "categories"]
[value ,categories]))))
(tr (td "URL:") (td (input ([type "text"] [size "83"] [name "url"] [value ,url]))))
(tr (td "Read?") (td (input ([type "checkbox"] [name "read"]
,@(if read
`([checked "true"])
`())))))
(tr (td ([valign "top"]) "Notes:") (td (textarea ([rows "24"] [cols "80"] [name "notes"]) ,notes)))
(tr (td ([colspan "2"] [align "right"])
(input ([type "submit"] [value ,(if the-paper
"Save"
"Add")]))))))))))
(define (generate-start path-to-db)
(let ([the-db:moc (new db:moc% (db-path path-to-db))])
(lambda (initial-request)
(report-errors-to-browser send/back)
(let ([url-compost (base-url initial-request)]
[bindings (request-bindings initial-request)])
(fluid-let ([db:moc the-db:moc]
[BASE-URL (string-append "http://"
(bytes->string/utf-8 (cdr (assoc 'host (request-headers initial-request))))
(car url-compost))])
(if (and (exists-binding? 'bookmarklet bindings)
(equal? (extract-binding/single 'bookmarklet bindings) "addPaper"))
(edit-paper/apply #f #t initial-request)
(list-papers/filters))))))))
![[logo]](/logo.png){kind=logo}