Documentation Source Text

Artifact Content
Login

Artifact 077695643e2e55df114066a0298b0f9276005d9b:


#!/home/dan/bin/tclsqlite3

source [file dirname [info script]]/document_header.tcl

# 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 {< &lt; > &gt;} $str }
proc attrize {str} { string map {< &lt; > &gt; \x22 \x5c\x22} $str }

#=========================================================================

proc cgi_env_dump {} {

  set ret "<h1>Arguments</h1><table>"
  foreach {key value} [array get ::A] {
    append ret "<tr><td>[htmlize $key]<td>[htmlize $value]"
  }
  append ret "</table>"

  append ret "<h1>Environment</h1><table>"
  foreach {key value} [array get ::env] {
    append ret "<tr><td>[htmlize $key]<td>[htmlize $value]"
  }
  append ret "</table>"
  return $ret
}

proc searchform {} {
  return {}
  set initial "Enter search term:"
  catch { set initial $::A(q) }
  return [subst {
    <table style="margin: 1em auto"> <tr><td>Search SQLite docs for:<td>
      <form name=f method=GET action=search>
        <input name=q type=text width=35 value="[attrize $initial]"></input>
        <input name=s type=submit value="Search"></input>
        <input name=s type=submit value="Lucky"></input>
      </form>
    </table>
    <script> 
      document.forms.f.q.focus()
      document.forms.f.q.select()
    </script>
  }]
}

proc footer {} {
  return {
    <hr>
    <table align=right>
    <td>
      <i>Powered by <a href="http://www.sqlite.org/fts5.html">FTS5</a>.</i>
    </table>
  }
}


#-------------------------------------------------------------------------
# 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} {
  return 10.0
  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 div 1.0
      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)]\""

  # Set nRes to the total number of documents that the user's query matches.
  #
  set rc [catch {
    set nRes [db one { SELECT count(*) FROM page WHERE page MATCH $::A(q) }]
  }]
  if {$rc} {
    set ::A(q) "\"$::A(q)\""
    set nRes [db one { SELECT count(*) FROM page WHERE page MATCH $::A(q) }]
  }

  db one { INSERT INTO page(page, rank) VALUES('rank', 'bm25(20.0, 10.0)') }

  # 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 }
  }

  # If nRes is 0, then the user's query returned zero results. Return a short 
  # message to that effect.
  #
  if {$nRes == 0} {
    return [subst { No results for: <b>[htmlize $::A(q)]</b> }]
  }
  set score 0
  catch {set score $::A(score)}

  # 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 {<span style="font-weight:xbold; color:navy">}
  set open {<span style="background-color:#b3e6cc">}
  set open {<span style="background-color:#c6ecd9">}
  set open {<span style="background-color:#d9f2e6">}
  set close {</span>}
  set ellipsis {<b>&nbsp;...&nbsp;</b>}

  set ret [subst {
    <table border=0>
    <p>Search results 
       [expr $iStart+1]..[expr {($nRes < $iStart+10) ? $nRes : $iStart+10}] 
       of $nRes for: <b>[htmlize $::A(q)]</b>
  }]
  db eval {
    SELECT 
      COALESCE(NULLIF(title,''), 'No Title.') AS title,
      snippet(page, 0, $open, $close, $ellipsis, 6) AS snippet1,
      snippet(page, 1, $open, $close, '', 40) AS snippet2,
      snippet(page, 2, $open, $close, $ellipsis, 40) AS snippet3,
      url, rank
    FROM page($::A(q)) ORDER BY rank
    LIMIT 10 OFFSET $iStart;
  } {
    #if {$snippet1!=""} { set snippet1 "($snippet1)" }
    append ret [subst -nocommands {<tr>
      <td valign=top style="line-height:150%">
        <div style="white-space:wrap;font-size:larger" class=nounderline>
          <xi><a href="$url">$snippet2</a> </i>
        </div>
          <div style="margin-left: 10ex; font:larger monospace">$snippet1</div>
        <div style="ffont-size:small;margin-left: 2ex">
          <div> $snippet3 </div>
          <div style="margin-left:1em; margin-bottom:1em"><a href="$url">$url</a></div>
        </div>
      </td>

    }]
  }
  append ret { </table> }


  # 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 <center><p>
    for {set i 0} {$i < 10 && ($i*10)<$nRes} {incr i} {
      append ret [subst {
        <a style="$s([expr {($iStart/10)==$i}])" 
           href="search?[cgi_encode_args [list q $::A(q) i $i]]">[expr $i+1]</a>
      }]
    }
    append ret </center>
  }

  return $ret
}

proc main {} {
  global A
  sqlite3 db search.db
  cgi_parse_args

  db transaction {
    set t [ttime { 
      if {[catch searchresults srchout]} {
        set A(q) [string tolower $A(q)]
        set srchout [searchresults]
      }
      set doc "[searchform] $srchout [footer]" 
    }]
  }
  append doc "<p>Page generated in $t."
  return $doc

  # return [cgi_env_dump]
}

#=========================================================================

source [file dirname [info script]]/document_header.tcl

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 ""
}



if {0==[catch main res]} {
  set title "Search SQLite Documentation"
  if {[info exists ::A(q)]} {
    set initsearch [attrize $::A(q)]
    append title " - [htmlize $::A(q)]"
  } else {
    set initsearch {}
  }
  set document [document_header $title "" $initsearch]
  append document $res
} else {
  set document "<pre>"
  append document "Error: $res\n\n"
  append document $::errorInfo
  append document "</pre>"
}

puts "Content-type: text/html" 
puts "Content-Length: [string length $document]"
puts ""
puts $document
puts ""
flush stdout
close stdout

exit