#!/usr/bin/tclsqlite3.fts3 # Decode an HTTP %-encoded string # proc percent_decode {str} { # rewrite "+" back to space # protect \ and [ and ] by quoting with '\' set str [string map [list + { } "\\" "\\\\" \[ \\\[ \] \\\]] $str] # prepare to process all %-escapes regsub -all -- {%([A-Fa-f][A-Fa-f0-9])%([A-Fa-f89][A-Fa-f0-9])} \ $str {[encoding convertfrom utf-8 [binary decode hex \1\2]]} str regsub -all -- {%([0-7][A-Fa-f0-9])} $str {\\u00\1} str # process %-escapes return [subst -novar $str] } #========================================================================= # This proc is called to parse the arguments passed to this invocation of # the CGI program (via either the GET or POST method). It returns a # key/value list containing the arguments suitable for passing to [array # set]. For example, if the CGI is invoked via a GET request on the URI: # # http://www.sqlite.org/search?query=fts3+table&results=10 # # then the returned list value is: # # {query {fts3 table} results 10} # proc cgi_parse_args {} { global env A if {$env(REQUEST_METHOD) == "GET"} { foreach q [split $env(QUERY_STRING) &] { if {[regexp {([a-z0-9]*)=(.*)} $q all var value]} { set A($var) [percent_decode $value] } } } elseif {$env(REQUEST_METHOD) == "POST"} { set qstring [read stdin $env(CONTENT_LENGTH)] foreach q [split $qstring &] { if {[regexp {([a-z0-9]*)=(.*)} $q all var value]} { set A($var) [percent_decode $value] } } } else { error "Unrecognized method: $env(REQUEST_METHOD)" } } #========================================================================= # Redirect the web-browser to URL $url. This command does not return. # proc cgi_redirect {url} { set server $::env(SERVER_NAME) set path [file dirname $::env(REQUEST_URI)] if {[string range $path end end]!="/"} { append path / } puts "Status: 302 Redirect" puts "Location: http://${server}${path}${url}" puts "Content-Length: 0" puts "" exit } #========================================================================= # The argument contains a key value list. The values in the list are # transformed to an HTTP query key value list. For example: # # % cgi_encode_args {s "search string" t "search \"type\""} # s=search+string&t=search+%22type%22 # proc cgi_encode_args {list} { set reslist [list] foreach {key value} $list { set value [string map { \x20 + \x21 %21 \x2A %2A \x22 %22 \x27 %27 \x28 %28 \x29 %29 \x3B %3B \x3A %3A \x40 %40 \x26 %26 \x3D %3D \x2B %2B \x24 %24 \x2C %2C \x2F %2F \x3F %3F \x25 %25 \x23 %23 \x5B %5B \x5D %5D } $value] lappend reslist "$key=$value" } join $reslist & } proc htmlize {str} { string map {< < > >} $str } proc attrize {str} { string map {< < > > \x22 \x5c\x22} $str } #========================================================================= proc cgi_env_dump {} { set ret "

Arguments

" foreach {key value} [array get ::A] { append ret "
[htmlize $key][htmlize $value]" } append ret "
" append ret "

Environment

" foreach {key value} [array get ::env] { append ret "
[htmlize $key][htmlize $value]" } append ret "
" return $ret } proc searchform {} { return {} set initial "Enter search term:" catch { set initial $::A(q) } return [subst {
Search SQLite docs for:
}] } proc footer {} { return {
Powered by FTS3.
} } #------------------------------------------------------------------------- # This command is similar to the builtin Tcl [time] command, except that # it only ever runs the supplied script once. Also, instead of returning # a string like "xxx microseconds per iteration", it returns "x.yy ms" or # "x.yy s", depending on the magnitude of the time spent running the # command. For example: # # % ttime {after 1500} # 1.50 s # % ttime {after 45} # 45.02 ms # proc ttime {script} { set t [lindex [time [list uplevel $script]] 0] if {$t>1000000} { return [format "%.2f s" [expr {$t/1000000.0}]] } return [format "%.2f ms" [expr {$t/1000.0}]] } proc rank {matchinfo args} { binary scan $matchinfo i* I set nPhrase [lindex $I 0] set nCol [lindex $I 1] set G [lrange $I 2 [expr {1+$nCol*$nPhrase}]] set L [lrange $I [expr {2+$nCol*$nPhrase}] end] foreach a $args { lappend log [expr {log10(100+$a)}] } set score 0.0 set i 0 foreach l $L g $G { if {$l > 0} { set div [lindex $log [expr $i%3]] set score [expr {$score + (double($l) / double($g)) / $div}] } incr i } return $score } proc erank {matchinfo args} { eval rank [list $matchinfo] $args } proc searchresults {} { if {![info exists ::A(q)]} return "" #set ::A(q) [string map {' ''} $A(q)] #regsub -all {[^-/"A-Za-z0-9]} $::A(q) { } ::A(q) # Count the '"' characters in $::A(q). If there is an odd number of # occurences, add a " to the end of the query so that fts3 can parse # it without error. if {[regexp -all \x22 $::A(q)] % 2} { append ::A(q) \x22 } set ::TITLE "Results for: \"[htmlize $::A(q)]\"" #db func rank rank #db func erank erank # If the user has clicked the "Lucky" button and the query returns one or # more results, redirect the browser to the highest ranked result. If the # query returns zero results, fall through and display the "No results" # page as if the user had clicked "Search". # if {[info exists ::A(s)] && $::A(s) == "Lucky"} { set url [db one { SELECT url FROM page, pagedata WHERE page MATCH $::A(q) AND page.docid = pagedata.docid ORDER BY rank(matchinfo(page), nk, nt, nc) DESC }] if {$url != ""} { cgi_redirect $url } } set score 0 catch {set score $::A(score)} # Set nRes to the total number of documents that the users query matches. # If nRes is 0, then the users query returned zero results. Return a short # message to that effect. # set nRes [db one { SELECT count(*) FROM page WHERE page MATCH $::A(q) }] if {$nRes == 0} { return [subst { No results for: [htmlize $::A(q)] }] } # Set iStart to the index of the first result to display. Results are # indexed starting at zero from most to least relevant. # set iStart [expr {([info exists ::A(i)] ? $::A(i) : 0)*10}] # HTML markup used to highlight keywords within FTS3 generated snippets. # set open {} set close {} set ellipsis { ... } set ret [subst {

Search results [expr $iStart+1]..[expr {($nRes < $iStart+10) ? $nRes : $iStart+10}] of $nRes for: [htmlize $::A(q)] }] db eval { SELECT result.rowid+$iStart AS resnum, COALESCE(NULLIF(title,''), 'No Title.') AS title, snippet(page, $open, $close, $ellipsis, 2, 40) AS snippet, url, CASE WHEN $score THEN erank(matchinfo(page), nk, nt, nc) ELSE '' END AS report FROM page, ( SELECT page.docid AS docid, url, nk, nt, nc FROM page, pagedata WHERE page MATCH $::A(q) AND page.docid = pagedata.docid ORDER BY rank(matchinfo(page), nk, nt, nc) DESC LIMIT 10 OFFSET $iStart ) AS result WHERE page MATCH $::A(q) AND page.docid = result.docid ORDER BY resnum; } { append ret [subst -nocommands {

}] } append ret {
${resnum}.
$title
$snippet
$report
} # If the query returned more than 10 results, add up to 10 links to # each set of 10 results (first link to results 1-10, second to 11-20, # third to 21-30, as required). # if {$nRes>10} { set s(0) {border: solid #044a64 1px ; padding: 1ex ; margin: 1ex} set s(1) "$s(0);background:#044a64;color:white" append ret

for {set i 0} {$i < 10 && ($i*10)<$nRes} {incr i} { append ret [subst { [expr $i+1] }] } append ret

} return $ret } proc main {} { global A sqlite3 db search.db cgi_parse_args db transaction { set t [ttime { set doc "[searchform] [searchresults] [footer]" }] } append doc "

Page generated in $t." return $doc # return [cgi_env_dump] } #========================================================================= set ::HEADER { $TITLE

Small. Fast. Reliable.
Choose any three.
} if {![info exists env(REQUEST_METHOD)]} { set env(REQUEST_METHOD) GET set env(QUERY_STRING) rebuild=1 set ::HEADER "" #set env(QUERY_STRING) {q="one+two+three+four"+eleven} set env(QUERY_STRING) {q=windows} set ::HEADER "" } set TITLE "Search SQLite Documentation" if {0==[catch main res]} { if {[info exists ::A(q)]} { set ::INITSEARCH \"[attrize $::A(q)]\" } else { set ::INITSEARCH \"\" } set document [subst -nocommands $::HEADER] append document $res } else { set document "
"
  append document "Error: $res\n\n"
  append document $::errorInfo
  append document "
" } puts "Content-type: text/html" puts "Content-Length: [string length $document]" puts "" puts $document puts "" flush stdout close stdout exit